Mumpster http://mumpster.org/ |
|
Unit 3 - Lesson 2: Create/Edit Database - Exercise 6 http://mumpster.org/viewtopic.php?f=29&t=1202 |
Page 1 of 1 |
Author: | tlwiechmann [ Tue Jul 12, 2011 10:32 am ] |
Post subject: | Unit 3 - Lesson 2: Create/Edit Database - Exercise 6 |
Exercise 5 Solution Routine: MP1PEDIT Code: MP1PEDIT ; Create/Edit Parts routine for the MP1 Course. New REC,X,PNUM,PDESC,PQTY,PLVL,PRC,PSP,UPPER,LOWER,IEN ; INIT ; Initialize all variables and drop through. Set (REC,PNUM,PDESC,PQTY,PLVL,PRC,PSP)="" Set IEN=0 ; PNUM ; Part Number Set X=$$ASK^MP1PVIEW("Part Number",PNUM) ;Ask for Part Number If '$$PNUM^MP1PDATA(X) Goto EXIT:X["^" Do Goto PNUM . Write !?5,"Enter 1-6 numeric digits. Required." If 'IEN Do . Set REC=$$GET^MP1PDATA(X) . Set IEN=+REC . Set REC=$Piece(REC,";",2,999) . Set PDESC=$Piece(REC,"^",2) . Set PQTY=$Piece(REC,"^",3) . Set PLVL=$Piece(REC,"^",4) . Set PRC=$Piece(REC,"^",5) . Set PSP=$Piece(REC,"^",6) Set PNUM=X ; PDESC ; Description Set X=$$ASK^MP1PVIEW("Description",PDESC,1) ;Ask for normalized Part Description If '$$PDESC^MP1PDATA(X) Goto PNUM:X["^" Do Goto PDESC . Write !?5,"Enter 1-30 characters starting with a letter. Required." Set PDESC=X ; PQTY ; Quantity Set X=$$ASK^MP1PVIEW("Quantity",PQTY) ;Ask for Part Quantity If '$$PQTY^MP1PDATA(X) Goto PDESC:X["^" Do Goto PQTY . Write !?5,"Enter an integer value. Required." Set PQTY=X ; PLVL ; Reorder Level (it's time to reorder the part if PQTY<PLVL) Set X=$$ASK^MP1PVIEW("Order Level",PLVL) ;Ask for Part Number If '$$PLVL^MP1PDATA(X) Goto PQTY:X["^" Do Goto PLVL . Write !?5,"Enter an integer value. Required." Set PLVL=X ; PRC ; Replacement Cost Set X=$$ASK^MP1PVIEW("Replacement Cost",PRC) ;Ask for Part Replacement Cost If '$$PRC^MP1PDATA(X) Goto PLVL:X["^" Do Goto PRC . Write !?5,"Enter replacement cost in dollars[.cents]" Set PRC=X ; PSP ; Selling Price Set X=$$ASK^MP1PVIEW("Selling Price",PSP) ;Ask for Part Selling Price If '$$PSP^MP1PDATA(X) Goto PRC:X["^" Do Goto PSP . Write !?5,"Enter selling price in dollars[.cents]" Set PSP=X ; FEI ; File/Edit/Ignore Entry New ERR Set X=$$ASK^MP1PVIEW("File, Edit or Ignore","File",1) ;Ask to File, Edit or Ignore If X["^" Goto PSP If $Extract("EDIT",1,$Length(X))=X Goto PNUM If $Extract("IGNORE",1,$Length(X))=X Goto INIT If $Extract("FILE",1,$Length(X))=X Do Goto PNUM:+ERR,INIT . Set REC=$$SETREC^MP1PDATA(PNUM,PDESC,PQTY,PLVL,PRC,PSP) . Set ERR=$$PUT^MP1PDATA(IEN,REC) . Write !,$Piece(ERR,";",2) Write " Enter F, E or I." Goto FEI ; EXIT ; Quit Routine: MP1XLATE Code: MP1XLATE ; Translation functions for MP1 course. Upper(S) ; Translate the value in the String variable to Uppercase. Set S=$Get(S) Quit $Translate(S,"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ") ; Lower(S) ; Translate the value in the String variable to Lowercase. Set S=$Get(S) Quit $Translate(S,"ABCDEFGHIJKLMNOPQRSTUVWXYZ","abcdefghijklmnopqrstuvwxyz") ; Routine: MP1PVIEW Code: MP1PVIEW ; View routines for MP1 course. ASK(Prompt,Default,Upper) ; Extrinsic function that asks for a value. ; Prompt – Contains prompt displayed to user. ; Default – Contains the default valuer to display ; Upper – 0 means no normalization to uppercase, 1 means normalization. ; Insure that the variable exist if not passed it. ; The $Get values are null by default if the second parameter is not specified. Set Prompt=$Get(Prompt) ;Default to null if not passed in. Set Default=$Get(Default) ;Default to null if not passed in. Set Upper=$Get(Upper,0) ;Default to 0 if not passed in. New X ; Protect callers X if it exists. Write !,Prompt,": " Write:Default]"" Default," // " Read X If X="" Set X=Default ; If null entered, take default If Upper Set X=$$Upper^MP1XLATE(X) ; If normalize to upper, call converter. Quit X ;Pass back the value to the caller. ; Routine: MP1PDATA Code: MP1PDATA ; Model side PUT and GET code for MP1 course GET(Key,Index) ; Return record based on primary key look up ; Determine the correct response to Key being null? Set Index=$Get(Index,"B") ;Default to primary index "B". New REC If $Data(^MP1PARTS(Index,Key)) Do . ;Edit entry . Set IEN=$Order(^MP1PARTS(Index,Key,"")) . Set REC=IEN_";"_^MP1PARTS(IEN) Else Do . ;Create Entry . Set REC=0_";" Quit REC ; PUT(IEN,REC) ; File the Parts record. ; IEN is either the Internal Entry Number or zero (not defined). ; REC is the full record structure. New OPNUM,OPDESC ; If entry does exist, get the old indice values. If IEN Do . ;Get original indices values. . Set OPNUM=$Piece(^MP1PARTS(IEN),"^",1) . Set OPDESC=$Piece(^MP1PARTS(IEN),"^",2) ; If entry does not exist, get a new Internal Entry Number (IEN). Else Do . ; Init old values to null - new record. . Set (OPNUM,OPDESC)="" . Lock +^MP1PARTS(0):0 ; Increment lock count on node. Force timeout. . Else Write !?5,"Cannot get next node number – record not filed." Quit . If '$Data(^MP1PARTS(0)) Set ^MP1PARTS(0)=0 . Set (IEN,^MP1PARTS(0))=^MP1PARTS(0)+1 . Lock -^MP1PARTS(0) ; Decrement lock count on node ; Make sure indices do not exist - multiple indices not permitted. If PNUM'=OPNUM,$Data(^MP1PARTS("B",PNUM)) Do Quit . Write !?5,"Number "_PNUM_" is already being used." If PDESC'=OPDESC,$Data(^MP1PARTS("C",PDESC)) Do Quit . Write !?5,"Description "_PDESC_" is already being used." ; Lock record node incrementally. Lock +^MP1PARTS(IEN):0 ; Increment lock count on record. Force timeout. ; If timeout occurred and no lock then pass back record busy message. Else Write !?5,"Record busy – record not filed." Quit ; Remove old indices. Kill:OPNUM]""&(OPNUM'=PNUM) ^MP1PARTS("B",OPNUM) Kill:OPDESC]""&(OPDESC'=PDESC) ^MP1PARTS("C",OPDESC) ; Set the new record and indices nodes. Set ^MP1PARTS(IEN)=PNUM_"^"_PDESC_"^"_PQTY_"^"_PLVL_"^"_PRC_"^"_PSP Set ^MP1PARTS("B",PNUM,IEN)="" Set ^MP1PARTS("C",PDESC,IEN)="" ; Incrementally unlock record node. Lock -^MP1PARTS(IEN) ; Decrement lock count on node Write !?5,"Record filed successfully." Quit ; SETREC(PNUM,PDESC,PQTY,PLVL,PRC,PSP) ; Construct Parts record. ; Parameters are passed by reference, not value. Quit PNUM_"^"_PDESC_"^"_PQTY_"^"_PLVL_"^"_PRC_"^"_PSP ; PNUM(X) ;Check PNUM syntax Quit $Select(X?1.6N:1,1:0) ; PDESC(X) ;Check PDESC syntax Quit $Select(X?1A.29NAP:1,1:0) ; PQTY(X) ;Check PNUM syntax Quit $Select(X?1.N:1,1:0) ; PLVL(X) ;Check PLVL syntax Quit $Select(X?1.N:1,1:0) ; PRC(X) ;Check PRC syntax Quit $Select(X?.N.1".".2N:1,1:0) ; PSP(X) ;Check PSP syntax Quit $Select(X?.N.1".".2N:1,1:0) ; Review
|
Page 1 of 1 | All times are UTC - 8 hours [ DST ] |
Powered by phpBB © 2000, 2002, 2005, 2007 phpBB Group http://www.phpbb.com/ |