It is currently Fri Jul 03, 2020 10:39 am

All times are UTC - 8 hours [ DST ]

Post new topic Reply to topic  [ 1 post ] 
Author Message
 Post subject: Unit 3 - Lesson 2: Create/Edit Database - Exercise 7
PostPosted: Tue Jul 19, 2011 6:31 am 
User avatar

Joined: Wed Nov 17, 2010 8:37 am
Posts: 136
Real Name: Terry L. Wiechmann
Began Programming in MUMPS: 0- 0-1971
Exercise 6 Solution

Routine: MP1PEDIT
MP1PEDIT ; Create/Edit Parts routine for the MP1 Course.
INIT ; Initialize all variables and drop through.
   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"
   Else  If '$$PNUM^MP1PDATA(X) Goto EXIT:X["^" Do  Goto PNUM
   . Do WRITEMSG^MP1PVIEW("Enter 1-6 numeric digits. Required.")
   If 'IEN Do
   . 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
   . 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))
EXIT   ;

Routine: MP1PVIEW

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
   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 !

Routine: MP1PDATA
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.
   ;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.
   . Set ERR="1;Number "_PNUM_" is already being used."
   . 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.
   . ; Set the new record and indices nodes.
   . 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)

  1. The code above accomplished the goals of last lesson in a very simple way. You can make this as elaborate as you want.
  2. Hopefully we have shown through a simple application how important it is to separate the code based on the Model-View-Controller pattern. It should be obvious at this point that you can replace the View-Controller objects with a different technology.
  3. There are a large number of MUMPS language elements that we did not cover. However, if you have gotten this far you should be able to use them where required with very little effort.
  4. It is quite obvious that using the dumb terminal IO commands to build the View and Controller sides of any application is a dead end. However, it's a really simple way to test the Model side of an application.
  5. The Model side of a MUMPS application, the database, is important. This is where MUMPS has excelled from the beginning. Consequently, we will focus on the Model side.

Terry L. Wiechmann

Offline Profile  
Display posts from previous:  Sort by  
Post new topic Reply to topic  [ 1 post ] 

All times are UTC - 8 hours [ DST ]

Who is online

Users browsing this forum: No registered users and 3 guests

You cannot post new topics in this forum
You cannot reply to topics in this forum
You cannot edit your posts in this forum
You cannot delete your posts in this forum
You cannot post attachments in this forum

Search for:
Jump to:  
Powered by phpBB © 2000, 2002, 2005, 2007 phpBB Group
Theme created