RMPRPIXN ;HINCIO/ODJ - PIP STOCK ORDERS 661.41 file APIs ;3/8/01
;;3.0;PROSTHETICS;**61**;Feb 09, 1996
Q
;
;***** GET - read in a HCPCS Item order record (661.41)
;
; Inputs:
; RMPR41 - array of order data fields...
; RMPR41("IEN") - ien of 661.41 record being read
;
; Outputs:
; RMPR11 - HCPCS Item array
; RMPR11("STATION") - Station name
; RMPR11("HCPCS") - HCPCS code
; RMPR11("ITEM") - HCPCS Item
;
; RMPR41 - Order data fields array
; RMPR41("DATE ORDER") - Order date (external)
; RMPR41("VENDOR") - Vendor name
; RMPR41("DATE RECEIVE") - Date of last receipt against the order
; (external)
; RMPR41("ORDER QTY") - Quantity ordered
; RMPR41("RECEIVE QTY") - Quantity received against the order
; RMPR41("COMMENT") - optional comment
; RMPR41("BALANCE QTY") - Balance quantity still on order
; RMPR41("STATUS") - Status (external)
;
; RMPRERR - error status returned by function
; 0 - no problems
; 1 - invalid RMPR41("IEN") entered
; 2 - Problem with FM call
;
GET(RMPR41,RMPR11) ;
N RMPRERR,RMPRIEN,RMPROUP,RMPRFME,X,Y,DA
S RMPRERR=0
I $G(RMPR41("IEN"))="" S RMPRERR=1 G GETX
S RMPRIEN=RMPR41("IEN")_","
D GETS^DIQ(661.41,RMPRIEN,"*","","RMPROUP","RMPRFME")
I $D(RMPRFME) S RMPRERR=2 G GETX
S RMPR11("STATION")=RMPROUP(661.41,RMPRIEN,2)
S RMPR11("HCPCS")=RMPROUP(661.41,RMPRIEN,5)
S RMPR11("ITEM")=RMPROUP(661.41,RMPRIEN,1)
S RMPR41("VENDOR")=RMPROUP(661.41,RMPRIEN,4)
S RMPR41("DATE ORDER")=RMPROUP(661.41,RMPRIEN,.01)
S RMPR41("DATE RECEIVE")=RMPROUP(661.41,RMPRIEN,6)
S RMPR41("ORDER QTY")=RMPROUP(661.41,RMPRIEN,7)
S RMPR41("RECEIVE QTY")=RMPROUP(661.41,RMPRIEN,8)
S RMPR41("COMMENT")=RMPROUP(661.41,RMPRIEN,9)
S RMPR41("BALANCE QTY")=RMPR41("ORDER QTY")-RMPR41("RECEIVE QTY")
S RMPR41("STATUS")=RMPROUP(661.41,RMPRIEN,10)
GETX Q RMPRERR
;
;***** GETI - get internal form of Order data fields
;
; Inputs and Outputs same as above for GET, except all internal values
; ie pointer's not names, internal not display date formats, etc.
;
GETI(RMPR41,RMPR11) ;
N RMPRERR,RMPRIEN,RMPROUP,RMPRFME,X,Y,DA
S RMPRERR=0
I $G(RMPR41("IEN"))="" S RMPRERR=1 G GETX
S RMPRIEN=RMPR41("IEN")_","
D GETS^DIQ(661.41,RMPRIEN,"*","I","RMPROUP","RMPRFME")
I $D(RMPRFME) S RMPRERR=2 G GETX
S RMPR11("STATION")=RMPROUP(661.41,RMPRIEN,2,"I")
S RMPR11("HCPCS")=RMPROUP(661.41,RMPRIEN,5,"I")
S RMPR11("ITEM")=RMPROUP(661.41,RMPRIEN,1,"I")
S RMPR41("VENDOR")=RMPROUP(661.41,RMPRIEN,4,"I")
S RMPR41("DATE ORDER")=RMPROUP(661.41,RMPRIEN,.01,"I")
S RMPR41("DATE RECEIVE")=RMPROUP(661.41,RMPRIEN,6,"I")
S RMPR41("ORDER QTY")=RMPROUP(661.41,RMPRIEN,7,"I")
S RMPR41("RECEIVE QTY")=RMPROUP(661.41,RMPRIEN,8,"I")
S RMPR41("COMMENT")=RMPROUP(661.41,RMPRIEN,9,"I")
S RMPR41("BALANCE QTY")=RMPR41("ORDER QTY")-RMPR41("RECEIVE QTY")
S RMPR41("STATUS")=RMPROUP(661.41,RMPRIEN,10,"I")
GETIX Q RMPRERR
;
;***** UPD - Update an existing Order 661.41 record
;
; Inputs/Outputs - see above
; See GETI above for structure of RMPR41 and RMPR11 input arrays
; values must be in internal form
;
UPD(RMPR41,RMPR11) ;
N RMPRERR,RMPRIEN,RMPROUP,RMPRFME,X,Y,DA
S RMPRERR=0
I $G(RMPR41("IEN"))="" S RMPRERR=1 G UPDX
S RMPRIEN=RMPR41("IEN")_","
S:$D(RMPR11("STATION")) RMPROUP(661.41,RMPRIEN,2)=RMPR11("STATION")
S:$D(RMPR11("HCPCS")) RMPROUP(661.41,RMPRIEN,5)=RMPR11("HCPCS")
S:$D(RMPR11("ITEM")) RMPROUP(661.41,RMPRIEN,1)=RMPR11("ITEM")
S:$D(RMPR41("DATE ORDER")) RMPROUP(661.41,RMPRIEN,.01)=RMPR41("DATE ORDER")
S:$D(RMPR41("DATE RECEIVE")) RMPROUP(661.41,RMPRIEN,6)=RMPR41("DATE RECEIVE")
S:$D(RMPR41("VENDOR")) RMPROUP(661.41,RMPRIEN,4)=RMPR41("VENDOR")
S:$D(RMPR41("ORDER QTY")) RMPROUP(661.41,RMPRIEN,7)=RMPR41("ORDER QTY")
S:$D(RMPR41("RECEIVE QTY")) RMPROUP(661.41,RMPRIEN,8)=RMPR41("RECEIVE QTY")
S:$D(RMPR41("COMMENT")) RMPROUP(661.41,RMPRIEN,9)=RMPR41("COMMENT")
S:$D(RMPR41("STATUS")) RMPROUP(661.41,RMPRIEN,10)=RMPR41("STATUS")
D:$D(RMPROUP) FILE^DIE("","RMPROUP","RMPRFME")
I $D(RMPRFME) S RMPRERR=2
UPDX Q RMPRERR
;
;***** CRE - Create an Order 661.41 record
;
; Inputs/Outputs - see above
; See GETI above for structure of RMPR41 and RMPR11 input arrays
; values must be in internal form
;
CRE(RMPR41,RMPR11) ;
N RMPRERR,RMPRIEN,RMPROUP,RMPRFME,X,Y,DA
S RMPRERR=0
S RMPROUP(661.41,"+1,",2)=RMPR11("STATION")
S RMPROUP(661.41,"+1,",5)=RMPR11("HCPCS")
S RMPROUP(661.41,"+1,",1)=RMPR11("ITEM")
S:$D(RMPR41("DATE ORDER")) RMPROUP(661.41,"+1,",.01)=RMPR41("DATE ORDER")
S:$D(RMPR41("DATE RECEIVE")) RMPROUP(661.41,"+1,",6)=RMPR41("DATE RECEIVE")
S:$D(RMPR41("VENDOR")) RMPROUP(661.41,"+1,",4)=RMPR41("VENDOR")
S:$D(RMPR41("ORDER QTY")) RMPROUP(661.41,"+1,",7)=RMPR41("ORDER QTY")
S:$D(RMPR41("RECEIVE QTY")) RMPROUP(661.41,"+1,",8)=RMPR41("RECEIVE QTY")
S RMPROUP(661.41,"+1,",9)=$G(RMPR41("COMMENT"))
S RMPROUP(661.41,"+1,",10)=RMPR41("STATUS")
D UPDATE^DIE("","RMPROUP","RMPRIEN","RMPRFME")
I $D(RMPRFME) S RMPRERR=1
S RMPR41("IEN")=RMPRIEN(1)
CREX Q RMPRERR
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRMPRPIXN 5218 printed Sep 11, 2024@02:56:41 Page 2
RMPRPIXN ;HINCIO/ODJ - PIP STOCK ORDERS 661.41 file APIs ;3/8/01
+1 ;;3.0;PROSTHETICS;**61**;Feb 09, 1996
+2 QUIT
+3 ;
+4 ;***** GET - read in a HCPCS Item order record (661.41)
+5 ;
+6 ; Inputs:
+7 ; RMPR41 - array of order data fields...
+8 ; RMPR41("IEN") - ien of 661.41 record being read
+9 ;
+10 ; Outputs:
+11 ; RMPR11 - HCPCS Item array
+12 ; RMPR11("STATION") - Station name
+13 ; RMPR11("HCPCS") - HCPCS code
+14 ; RMPR11("ITEM") - HCPCS Item
+15 ;
+16 ; RMPR41 - Order data fields array
+17 ; RMPR41("DATE ORDER") - Order date (external)
+18 ; RMPR41("VENDOR") - Vendor name
+19 ; RMPR41("DATE RECEIVE") - Date of last receipt against the order
+20 ; (external)
+21 ; RMPR41("ORDER QTY") - Quantity ordered
+22 ; RMPR41("RECEIVE QTY") - Quantity received against the order
+23 ; RMPR41("COMMENT") - optional comment
+24 ; RMPR41("BALANCE QTY") - Balance quantity still on order
+25 ; RMPR41("STATUS") - Status (external)
+26 ;
+27 ; RMPRERR - error status returned by function
+28 ; 0 - no problems
+29 ; 1 - invalid RMPR41("IEN") entered
+30 ; 2 - Problem with FM call
+31 ;
GET(RMPR41,RMPR11) ;
+1 NEW RMPRERR,RMPRIEN,RMPROUP,RMPRFME,X,Y,DA
+2 SET RMPRERR=0
+3 IF $GET(RMPR41("IEN"))=""
SET RMPRERR=1
GOTO GETX
+4 SET RMPRIEN=RMPR41("IEN")_","
+5 DO GETS^DIQ(661.41,RMPRIEN,"*","","RMPROUP","RMPRFME")
+6 IF $DATA(RMPRFME)
SET RMPRERR=2
GOTO GETX
+7 SET RMPR11("STATION")=RMPROUP(661.41,RMPRIEN,2)
+8 SET RMPR11("HCPCS")=RMPROUP(661.41,RMPRIEN,5)
+9 SET RMPR11("ITEM")=RMPROUP(661.41,RMPRIEN,1)
+10 SET RMPR41("VENDOR")=RMPROUP(661.41,RMPRIEN,4)
+11 SET RMPR41("DATE ORDER")=RMPROUP(661.41,RMPRIEN,.01)
+12 SET RMPR41("DATE RECEIVE")=RMPROUP(661.41,RMPRIEN,6)
+13 SET RMPR41("ORDER QTY")=RMPROUP(661.41,RMPRIEN,7)
+14 SET RMPR41("RECEIVE QTY")=RMPROUP(661.41,RMPRIEN,8)
+15 SET RMPR41("COMMENT")=RMPROUP(661.41,RMPRIEN,9)
+16 SET RMPR41("BALANCE QTY")=RMPR41("ORDER QTY")-RMPR41("RECEIVE QTY")
+17 SET RMPR41("STATUS")=RMPROUP(661.41,RMPRIEN,10)
GETX QUIT RMPRERR
+1 ;
+2 ;***** GETI - get internal form of Order data fields
+3 ;
+4 ; Inputs and Outputs same as above for GET, except all internal values
+5 ; ie pointer's not names, internal not display date formats, etc.
+6 ;
GETI(RMPR41,RMPR11) ;
+1 NEW RMPRERR,RMPRIEN,RMPROUP,RMPRFME,X,Y,DA
+2 SET RMPRERR=0
+3 IF $GET(RMPR41("IEN"))=""
SET RMPRERR=1
GOTO GETX
+4 SET RMPRIEN=RMPR41("IEN")_","
+5 DO GETS^DIQ(661.41,RMPRIEN,"*","I","RMPROUP","RMPRFME")
+6 IF $DATA(RMPRFME)
SET RMPRERR=2
GOTO GETX
+7 SET RMPR11("STATION")=RMPROUP(661.41,RMPRIEN,2,"I")
+8 SET RMPR11("HCPCS")=RMPROUP(661.41,RMPRIEN,5,"I")
+9 SET RMPR11("ITEM")=RMPROUP(661.41,RMPRIEN,1,"I")
+10 SET RMPR41("VENDOR")=RMPROUP(661.41,RMPRIEN,4,"I")
+11 SET RMPR41("DATE ORDER")=RMPROUP(661.41,RMPRIEN,.01,"I")
+12 SET RMPR41("DATE RECEIVE")=RMPROUP(661.41,RMPRIEN,6,"I")
+13 SET RMPR41("ORDER QTY")=RMPROUP(661.41,RMPRIEN,7,"I")
+14 SET RMPR41("RECEIVE QTY")=RMPROUP(661.41,RMPRIEN,8,"I")
+15 SET RMPR41("COMMENT")=RMPROUP(661.41,RMPRIEN,9,"I")
+16 SET RMPR41("BALANCE QTY")=RMPR41("ORDER QTY")-RMPR41("RECEIVE QTY")
+17 SET RMPR41("STATUS")=RMPROUP(661.41,RMPRIEN,10,"I")
GETIX QUIT RMPRERR
+1 ;
+2 ;***** UPD - Update an existing Order 661.41 record
+3 ;
+4 ; Inputs/Outputs - see above
+5 ; See GETI above for structure of RMPR41 and RMPR11 input arrays
+6 ; values must be in internal form
+7 ;
UPD(RMPR41,RMPR11) ;
+1 NEW RMPRERR,RMPRIEN,RMPROUP,RMPRFME,X,Y,DA
+2 SET RMPRERR=0
+3 IF $GET(RMPR41("IEN"))=""
SET RMPRERR=1
GOTO UPDX
+4 SET RMPRIEN=RMPR41("IEN")_","
+5 if $DATA(RMPR11("STATION"))
SET RMPROUP(661.41,RMPRIEN,2)=RMPR11("STATION")
+6 if $DATA(RMPR11("HCPCS"))
SET RMPROUP(661.41,RMPRIEN,5)=RMPR11("HCPCS")
+7 if $DATA(RMPR11("ITEM"))
SET RMPROUP(661.41,RMPRIEN,1)=RMPR11("ITEM")
+8 if $DATA(RMPR41("DATE ORDER"))
SET RMPROUP(661.41,RMPRIEN,.01)=RMPR41("DATE ORDER")
+9 if $DATA(RMPR41("DATE RECEIVE"))
SET RMPROUP(661.41,RMPRIEN,6)=RMPR41("DATE RECEIVE")
+10 if $DATA(RMPR41("VENDOR"))
SET RMPROUP(661.41,RMPRIEN,4)=RMPR41("VENDOR")
+11 if $DATA(RMPR41("ORDER QTY"))
SET RMPROUP(661.41,RMPRIEN,7)=RMPR41("ORDER QTY")
+12 if $DATA(RMPR41("RECEIVE QTY"))
SET RMPROUP(661.41,RMPRIEN,8)=RMPR41("RECEIVE QTY")
+13 if $DATA(RMPR41("COMMENT"))
SET RMPROUP(661.41,RMPRIEN,9)=RMPR41("COMMENT")
+14 if $DATA(RMPR41("STATUS"))
SET RMPROUP(661.41,RMPRIEN,10)=RMPR41("STATUS")
+15 if $DATA(RMPROUP)
DO FILE^DIE("","RMPROUP","RMPRFME")
+16 IF $DATA(RMPRFME)
SET RMPRERR=2
UPDX QUIT RMPRERR
+1 ;
+2 ;***** CRE - Create an Order 661.41 record
+3 ;
+4 ; Inputs/Outputs - see above
+5 ; See GETI above for structure of RMPR41 and RMPR11 input arrays
+6 ; values must be in internal form
+7 ;
CRE(RMPR41,RMPR11) ;
+1 NEW RMPRERR,RMPRIEN,RMPROUP,RMPRFME,X,Y,DA
+2 SET RMPRERR=0
+3 SET RMPROUP(661.41,"+1,",2)=RMPR11("STATION")
+4 SET RMPROUP(661.41,"+1,",5)=RMPR11("HCPCS")
+5 SET RMPROUP(661.41,"+1,",1)=RMPR11("ITEM")
+6 if $DATA(RMPR41("DATE ORDER"))
SET RMPROUP(661.41,"+1,",.01)=RMPR41("DATE ORDER")
+7 if $DATA(RMPR41("DATE RECEIVE"))
SET RMPROUP(661.41,"+1,",6)=RMPR41("DATE RECEIVE")
+8 if $DATA(RMPR41("VENDOR"))
SET RMPROUP(661.41,"+1,",4)=RMPR41("VENDOR")
+9 if $DATA(RMPR41("ORDER QTY"))
SET RMPROUP(661.41,"+1,",7)=RMPR41("ORDER QTY")
+10 if $DATA(RMPR41("RECEIVE QTY"))
SET RMPROUP(661.41,"+1,",8)=RMPR41("RECEIVE QTY")
+11 SET RMPROUP(661.41,"+1,",9)=$GET(RMPR41("COMMENT"))
+12 SET RMPROUP(661.41,"+1,",10)=RMPR41("STATUS")
+13 DO UPDATE^DIE("","RMPROUP","RMPRIEN","RMPRFME")
+14 IF $DATA(RMPRFME)
SET RMPRERR=1
+15 SET RMPR41("IEN")=RMPRIEN(1)
CREX QUIT RMPRERR