Mumpster http://mumpster.org/ |
|
Unit 3 - Lesson 2: Create/Edit Database - Exercise 7 http://mumpster.org/viewtopic.php?f=29&t=1253 |
Page 1 of 1 |
Author: | tlwiechmann [ Tue Jul 19, 2011 6:31 am ] |
Post subject: | Unit 3 - Lesson 2: Create/Edit Database - Exercise 7 |
Exercise 6 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,KEY,ERR ; 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 ; List all entries. If X="^L" Do LIST Goto PNUM Set KEY="B" If $$PDESC^MP1PDATA(X) Set KEY="C" Else If '$$PNUM^MP1PDATA(X) Goto EXIT:X["^" Do Goto PNUM . Do WRITEMSG^MP1PVIEW("Enter 1-6 numeric digits. Required.") If 'IEN Do . Set REC=$$GET^MP1PDATA(X,KEY) . Set IEN=+REC . Set REC=$Piece(REC,";",2,999) ;Data Elements may have ";" in them. . 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 . Do WRITEMSG^MP1PVIEW("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 . Do WRITEMSG^MP1PVIEW("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 . Do WRITEMSG^MP1PVIEW("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 PSP:X="",PLVL:X["^" Do Goto PRC . Do WRITEMSG^MP1PVIEW("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 FEI:X="",PRC:X["^" Do Goto PSP . Do WRITEMSG^MP1PVIEW("Enter selling price in dollars[.cents]") Set PSP=X ; FEI ; File/Edit/Ignore Entry 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) . Do WRITEMSG^MP1PVIEW($Piece(ERR,";",2)) Do WRITEMSG^MP1PVIEW(" Enter F, E or I.") Goto FEI ; LIST ; New NXT,REC Set NXT="" ; Loop through "B" index (default). For Set NXT=$$NEXT^MP1PDATA(NXT) Quit:NXT="" Do . Set REC=$$GET^MP1PDATA(NXT) ;Default to "B" index. . Do WRITEREC^MP1PVIEW($Piece(REC,";",2)) Quit ; EXIT ; Quit 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. ; WRITEMSG(MSG) ; Write Error/Help message with formatting. Use $Principal Write !?5,MSG Quit ; WRITEREC(REC) ; Write ! Write !?5,"Part Number: ",$Piece(REC,"^",1) Write !?5,"Part Description: ",$Piece(REC,"^",2) Write !?5,"Part Quantity: ",$Piece(REC,"^",3) Write !?5,"Part Order Level: ",$Piece(REC,"^",4) Write !?5,"Part Replacement Cost: ",$FNumber($Piece(REC,"^",5),"p,",2) Write !?5,"Part Selling Price: ",$FNumber($Piece(REC,"^",6),"p,",2) Write ! Quit Routine: MP1PDATA Code: MP1PDATA ; Model side PUT and GET code for MP1 course ; NEXT(Key,Index) ; Return the next entry using the specified key and index. Set Index=$Get(Index,"B") ;Default to primary index "B". Quit $Order(^MP1PARTS(Index,Key)) ; 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 ERR,OPNUM,OPDESC ;Default return message to success. Set ERR="0;Record filed successfully." ; Initial error state to success. ; Get indice values. Set PNUM=$Piece(REC,"^",1) Set PDESC=$Piece(REC,"^",2) ; If entry does exist, get the old indice values. If IEN Do . 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 Set ERR="3;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 permittted. If PNUM'=OPNUM,$Data(^MP1PARTS("B",PNUM)) Do . Set ERR="1;Number "_PNUM_" is already being used." If PDESC'=OPDESC,$Data(^MP1PARTS("C",PDESC)) Do . Set ERR="2;Description "_PDESC_" is already being used." If 'ERR Do ;File if no errors. . ; 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 Set ERR="4;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)=REC . Set ^MP1PARTS("B",PNUM,IEN)="" . Set ^MP1PARTS("C",PDESC,IEN)="" . ; Incrementally unlock record node. . Lock -^MP1PARTS(IEN) ; Decrement lock count on node Quit ERR ; 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/ |