RMPRPIX6 ;HINCIO/ODJ - PIP TRANSACTION FILE 661.6 API ;3/8/01
;;3.0;PROSTHETICS;**61**;Feb 09, 1996
Q
;
;***** CRE - create new 661.6 PIP Transaction record
;
; Inputs:
; RMPR616 - Transaction array (661.6)
; (elements mandatory unless noted)
; RMPR616("DATE&TIME") - (optional) usually should not be set
; but if it is RMPR616("SEQUENCE")
; must also be set
; RMPR616("SEQUENCE") - (optional) but see above
; should normally be one
; RMPR616("VENDOR") - Vendor ien
; RMPR616("LOCATION") - Location ien (ptr 661.5)
; RMPR616("TRAN TYPE") - Transaction Type code (see 661.6 spec)
; RMPR616("QUANTITY") - Quantity
; RMPR616("VALUE") - $ Value of transaction
; RMPR616("COMMENT") - Coment
; RMPR616("USER") - User ien (ptr VA(200,)
;
; RMPR6111 - HCPCS Item array (661.11) (all elements mandatory)
; RMPR6111("STATION") - Station ien (ptr ^DIC(4,)
; RMPR6111("HCPCS") - HCPCS code
; RMPR6111("ITEM") - HCPCS Item number
;
; Outputs:
; RMPR616("IEN") - ien of created Transaction
; RMPRERR - error code returned by function
; 0 - no problems
; 1 - FM problems creating 661.6 rec.
;
CRE(RMPR616,RMPR6111) ;
N RMPRRET,RMPRIENA,RMPRFDA,RMPRFME,X,Y,DA
S RMPRRET=0
;
; Get DATE&TIME for transaction and lock the file
I $G(RMPR616("DATE&TIME"))="" G CRE0
L +^RMPR(661.6,"XHDS",RMPR6111("HCPCS"),RMPR616("DATE&TIME"))
I $D(^RMPR(661.6,"XHDS",RMPR6111("HCPCS"),RMPR616("DATE&TIME"),RMPR616("SEQUENCE"))) L -^RMPR(661.6,"XHDS",RMPR6111("HCPCS"),RMPR616("DATE&TIME")) G CRE0
G CRE1
CRE0 S RMPR616("DATE&TIME")=""
F D Q:RMPR616("DATE&TIME")'=""
. D NOW^%DTC
. I $D(^RMPR(661.6,"XHDS",RMPR6111("HCPCS"),%,1)) H (1+$R(3)) Q
. L +^RMPR(661.6,"XHDS",RMPR6111("HCPCS"),%):0 E H (1+$R(3)) Q
. S RMPR616("DATE&TIME")=%
. S RMPR616("SEQUENCE")=1
. Q
;
; Create the transaction
CRE1 S RMPRFDA(661.6,"+1,",.01)=RMPR6111("HCPCS")
S RMPRFDA(661.6,"+1,",2)=RMPR616("DATE&TIME")
S RMPRFDA(661.6,"+1,",3)=RMPR616("SEQUENCE")
S RMPRFDA(661.6,"+1,",4)=RMPR616("TRAN TYPE")
S RMPRFDA(661.6,"+1,",5)=RMPR616("QUANTITY")
S RMPRFDA(661.6,"+1,",6)=RMPR616("VALUE")
S RMPRFDA(661.6,"+1,",8)=RMPR616("COMMENT")
S RMPRFDA(661.6,"+1,",9)=RMPR616("USER")
S RMPRFDA(661.6,"+1,",11)=RMPR6111("ITEM")
S RMPRFDA(661.6,"+1,",12)=RMPR616("VENDOR")
S RMPRFDA(661.6,"+1,",13)=RMPR6111("STATION")
S RMPRFDA(661.6,"+1,",14)=RMPR616("LOCATION")
D UPDATE^DIE("","RMPRFDA","RMPRIENA","RMPRFME")
L -^RMPR(661.6,"XHDS",RMPR6111("HCPCS"),RMPR616("DATE&TIME"))
I $D(RMPRFME) S RMPRRET=1 G CREX
S RMPR616("IEN")=RMPRIENA(1)
CREX Q RMPRRET
;
;***** UPD - update existing Transaction (661.6) record
;
; Inputs:
; RMPR616 - Transaction array (see above for CRE)
; RMPR616("IEN") - ien of rec to update (mandatory)
; all other elements optional but DATE&TIME
; and SEQUENCE cannot be changed
; RMPR6111 - HCPCS array (see above for CRE)
; all elements optional
;
; Outputs:
; RMPRRET - error code returned by function
; 0 - no problems
; 1 - invalid RMPR616("IEN")
; 2 - FM problem with update
;
UPD(RMPR616,RMPR6111) ;
N RMPRRET,RMPRI,RMPRFDA,RMPRFME,X,Y,DA
S RMPRRET=0
I $G(RMPR616("IEN"))="" S RMPRRET=1 G UPDX
S RMPRI=RMPR616("IEN")_","
S:$D(RMPR6111("HCPCS")) RMPRFDA(661.6,RMPRI,.01)=RMPR6111("HCPCS")
S:$D(RMPR616("QUANTITY")) RMPRFDA(661.6,RMPRI,5)=RMPR616("QUANTITY")
S:$D(RMPR616("VALUE")) RMPRFDA(661.6,RMPRI,6)=RMPR616("VALUE")
S:$D(RMPR616("COMMENT")) RMPRFDA(661.6,RMPRI,8)=RMPR616("COMMENT")
S:$D(RMPR616("USER")) RMPRFDA(661.6,RMPRI,9)=RMPR616("USER")
S:$D(RMPR6111("ITEM")) RMPRFDA(661.6,RMPRI,11)=RMPR6111("ITEM")
S:$D(RMPR616("VENDOR")) RMPRFDA(661.6,RMPRI,12)=RMPR616("VENDOR")
S:$D(RMPR616("LOCATION")) RMPRFDA(661.6,RMPRI,14)=RMPR616("LOCATION")
D:$D(RMPRFDA) FILE^DIE("","RMPRFDA","RMPRFME")
I $D(RMPRFME) S RMPRRET=2 G UPDX
UPDX Q RMPRRET
;
;***** GET - read in 661.6 record
GET(RMPR) ;
N RMPRRET,RMPRFME,RMPRIEN,RMPRKEY,RMPRERR,RMPROUP,X,Y,DA,RMPREOF
S RMPRRET=0
I $G(RMPR("IEN"))="" D
. I $G(RMPR("HCPCS"))="" S RMPRRET=1 Q
. I $G(RMPR("DATE&TIME"))="" S RMPRRET=2 Q
. S RMPRKEY("HCPCS")=RMPR("HCPCS")
. S RMPRKEY("DATE&TIME")=RMPR("DATE&TIME")
. S RMPRERR=$$NEXT^RMPRPIXA(.RMPRKEY,"XHDS","",-1,,.RMPREOF)
. I RMPRERR S RMPRRET=3 Q
. I '$D(RMPRKEY("SEQUENCE")) S RMPRRET=1 Q
. I RMPRKEY("SEQUENCE")'=1 S RMPRRET=4 Q
. S RMPR("IEN")=RMPRKEY("IEN")
. Q
I RMPRRET G GETX
S RMPRIEN=RMPR("IEN")_","
D GETS^DIQ(661.6,RMPRIEN,"*","","RMPROUP","RMPRFME")
I $D(RMPRFME) S RMPRRET=5 G GETX
S RMPR("HCPCS")=RMPROUP(661.6,RMPRIEN,.01)
S RMPR("DATE&TIME")=RMPROUP(661.6,RMPRIEN,2)
S RMPR("DATE")=$P(RMPR("DATE&TIME"),"@",1)
S RMPR("TIME")=$P(RMPR("DATE&TIME"),"@",2)
S RMPR("SEQUENCE")=RMPROUP(661.6,RMPRIEN,3)
S RMPR("TRAN TYPE")=RMPROUP(661.6,RMPRIEN,4)
S RMPR("QUANTITY")=RMPROUP(661.6,RMPRIEN,5)
S RMPR("VALUE")=RMPROUP(661.6,RMPRIEN,6)
S RMPR("COMMENT")=RMPROUP(661.6,RMPRIEN,8)
S RMPR("USER")=RMPROUP(661.6,RMPRIEN,9)
S RMPR("ITEM")=RMPROUP(661.6,RMPRIEN,11)
S RMPR("VENDOR")=RMPROUP(661.6,RMPRIEN,12)
S RMPR("STATION")=RMPROUP(661.6,RMPRIEN,13)
S RMPR("LOCATION")=RMPROUP(661.6,RMPRIEN,14)
GETX Q RMPRRET
;
;***** ETOI - convert external to internal form
ETOI(RMPRE,RMPRI) ;
N RMPRFDA,RMPRIEN,RMPRFDI,RMPRFME,RMPRERR
S RMPRERR=0
S RMPRIEN=RMPRE("IEN")_","
D GETS^DIQ(661.6,RMPRIEN,"*","I","RMPRFDI","RMPRFME")
I $D(RMPRFME) S RMPRERR=1 G ETOIX
S RMPRI("IEN")=RMPRE("IEN")
S RMPRI("HCPCS")=RMPRFDI(661.6,RMPRIEN,.01,"I")
S RMPRI("DATE&TIME")=RMPRFDI(661.6,RMPRIEN,2,"I")
S RMPRI("DATE")=$P(RMPRI("DATE&TIME"),".",1)
S RMPRI("TIME")=$P(RMPRI("DATE&TIME"),".",2)
S RMPRI("SEQUENCE")=RMPRFDI(661.6,RMPRIEN,3,"I")
S RMPRI("TRAN TYPE")=RMPRFDI(661.6,RMPRIEN,4,"I")
S RMPRI("QUANTITY")=RMPRFDI(661.6,RMPRIEN,5,"I")
S RMPRI("VALUE")=RMPRFDI(661.6,RMPRIEN,6,"I")
S RMPRI("COMMENT")=RMPRFDI(661.6,RMPRIEN,8,"I")
S RMPRI("USER")=RMPRFDI(661.6,RMPRIEN,9,"I")
S RMPRI("ITEM")=RMPRFDI(661.6,RMPRIEN,11,"I")
S RMPRI("VENDOR")=RMPRFDI(661.6,RMPRIEN,12,"I")
S RMPRI("STATION")=RMPRFDI(661.6,RMPRIEN,13,"I")
S RMPRI("LOCATION")=RMPRFDI(661.6,RMPRIEN,14,"I")
ETOIX Q RMPRERR
;
; TFLOW - sets RMPR("TRAN FLOW")
TFLOW(RMPR) ;
N RMPRFDA,RMPRIEN,RMPRFDI,RMPRFME,RMPRERR,RMPRTYP
S RMPRERR=0
S RMPRIEN=RMPR("IEN")_","
S RMPRFDA(661.6,RMPRIEN,4)=RMPR("TRAN TYPE")
D VALS^DIE("","RMPRFDA","RMPRFDI","RMPRFME")
I $D(RMPRFME) S RMPRERR=1 G TFLOWX
S RMPRTYP=","_RMPRFDI(661.6,RMPRIEN,4)_","
S RMPR("TRAN FLOW")=""
I ",1,8,"[RMPRTYP S RMPR("TRAN FLOW")="+"
I ",2,7,"[RMPRTYP S RMPR("TRAN FLOW")=""
I ",3,4,5,6,"[RMPRTYP S RMPR("TRAN FLOW")="-"
I ",9,"[RMPRTYP S RMPR("TRAN FLOW")="="
TFLOWX Q RMPRERR
;
; DTIEN - sets internal form of DATE/TIME
DTIEN(RMPR) ;
N RMPRFDA,RMPRIEN,RMPRFDI,RMPRFME,RMPRERR
S RMPRERR=0
S RMPRIEN=RMPR("IEN")_","
D GETS^DIQ(661.6,RMPRIEN,"*","I","RMPRFDI","RMPRFME")
S RMPR("DATE&TIME")=RMPRFDI(661.6,RMPRIEN,2,"I")
Q RMPRERR
;
; STNIEN - sets RMPR("STATION IEN")
STNIEN(RMPR) ;
N RMPRFDA,RMPRIEN,RMPRFDI,RMPRFME,RMPRERR
S RMPRERR=0
S RMPRIEN=RMPR("IEN")_","
D GETS^DIQ(661.6,RMPRIEN,"*","I","RMPRFDI","RMPRFME")
I $D(RMPRFME) S RMPRERR=1 G STNIENX
S RMPR("STATION IEN")=RMPRFDI(661.6,RMPRIEN,13,"I")
STNIENX Q RMPRERR
;
; VNDIEN - sets RMPR("VENDOR IEN")
VNDIEN(RMPR) ;
N RMPRFDA,RMPRIEN,RMPRFDI,RMPRFME,RMPRERR
S RMPRERR=0
I '$D(RMPR("IEN")) W !!,"*** MISSING POINTER TO VENDOR FILE, PLEASE CHECK FILE #661.11 !!!",! S RMPRERR=1 G VNDIENX
S RMPRIEN=RMPR("IEN")_","
D GETS^DIQ(661.6,RMPRIEN,"12","I","RMPRFDI","RMPRFME")
I $D(RMPRFME) S RMPRERR=1 G VNDIENX
S RMPR("VENDOR IEN")=RMPRFDI(661.6,RMPRIEN,12,"I")
VNDIENX Q RMPRERR
;
; DEL - Delete a record
DEL(RMPR6) ;
N RMPRFDA,RMPRFME,RMPRERR,RMPRIEN,X,Y,DA
S RMPRERR=0
I $G(RMPR6("IEN"))="" S RMPRERR=1 G DELX
S RMPRIEN=RMPR6("IEN")_","
S RMPRFDA(661.6,RMPRIEN,.01)="@"
D FILE^DIE("","RMPRFDA","RMPRFME")
I $D(RMPRFME) S RMPRERR=1
DELX Q RMPRERR
;
; Get the ien for a 2319 patient stock issue record in file 660
IEN60(RMPR6,RMPR60) ;
N RMPRERR,RMPRIEN
S RMPRERR=0
I $G(RMPR6("IEN"))="" S RMPRERR=1 G IEN60X
S RMPRIEN=$O(^RMPR(661.63,"B",RMPR6("IEN"),""))
I RMPRIEN="" S RMPRERR=2 G IEN60X
S RMPR60("IEN")=$P($G(^RMPR(661.63,RMPRIEN,0)),"^",2)
IEN60X Q RMPRERR
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRMPRPIX6 8779 printed Sep 23, 2025@20:12:47 Page 2
RMPRPIX6 ;HINCIO/ODJ - PIP TRANSACTION FILE 661.6 API ;3/8/01
+1 ;;3.0;PROSTHETICS;**61**;Feb 09, 1996
+2 QUIT
+3 ;
+4 ;***** CRE - create new 661.6 PIP Transaction record
+5 ;
+6 ; Inputs:
+7 ; RMPR616 - Transaction array (661.6)
+8 ; (elements mandatory unless noted)
+9 ; RMPR616("DATE&TIME") - (optional) usually should not be set
+10 ; but if it is RMPR616("SEQUENCE")
+11 ; must also be set
+12 ; RMPR616("SEQUENCE") - (optional) but see above
+13 ; should normally be one
+14 ; RMPR616("VENDOR") - Vendor ien
+15 ; RMPR616("LOCATION") - Location ien (ptr 661.5)
+16 ; RMPR616("TRAN TYPE") - Transaction Type code (see 661.6 spec)
+17 ; RMPR616("QUANTITY") - Quantity
+18 ; RMPR616("VALUE") - $ Value of transaction
+19 ; RMPR616("COMMENT") - Coment
+20 ; RMPR616("USER") - User ien (ptr VA(200,)
+21 ;
+22 ; RMPR6111 - HCPCS Item array (661.11) (all elements mandatory)
+23 ; RMPR6111("STATION") - Station ien (ptr ^DIC(4,)
+24 ; RMPR6111("HCPCS") - HCPCS code
+25 ; RMPR6111("ITEM") - HCPCS Item number
+26 ;
+27 ; Outputs:
+28 ; RMPR616("IEN") - ien of created Transaction
+29 ; RMPRERR - error code returned by function
+30 ; 0 - no problems
+31 ; 1 - FM problems creating 661.6 rec.
+32 ;
CRE(RMPR616,RMPR6111) ;
+1 NEW RMPRRET,RMPRIENA,RMPRFDA,RMPRFME,X,Y,DA
+2 SET RMPRRET=0
+3 ;
+4 ; Get DATE&TIME for transaction and lock the file
+5 IF $GET(RMPR616("DATE&TIME"))=""
GOTO CRE0
+6 LOCK +^RMPR(661.6,"XHDS",RMPR6111("HCPCS"),RMPR616("DATE&TIME"))
+7 IF $DATA(^RMPR(661.6,"XHDS",RMPR6111("HCPCS"),RMPR616("DATE&TIME"),RMPR616("SEQUENCE")))
LOCK -^RMPR(661.6,"XHDS",RMPR6111("HCPCS"),RMPR616("DATE&TIME"))
GOTO CRE0
+8 GOTO CRE1
CRE0 SET RMPR616("DATE&TIME")=""
+1 FOR
Begin DoDot:1
+2 DO NOW^%DTC
+3 IF $DATA(^RMPR(661.6,"XHDS",RMPR6111("HCPCS"),%,1))
HANG (1+$RANDOM(3))
QUIT
+4 LOCK +^RMPR(661.6,"XHDS",RMPR6111("HCPCS"),%):0
IF '$TEST
HANG (1+$RANDOM(3))
QUIT
+5 SET RMPR616("DATE&TIME")=%
+6 SET RMPR616("SEQUENCE")=1
+7 QUIT
End DoDot:1
if RMPR616("DATE&TIME")'=""
QUIT
+8 ;
+9 ; Create the transaction
CRE1 SET RMPRFDA(661.6,"+1,",.01)=RMPR6111("HCPCS")
+1 SET RMPRFDA(661.6,"+1,",2)=RMPR616("DATE&TIME")
+2 SET RMPRFDA(661.6,"+1,",3)=RMPR616("SEQUENCE")
+3 SET RMPRFDA(661.6,"+1,",4)=RMPR616("TRAN TYPE")
+4 SET RMPRFDA(661.6,"+1,",5)=RMPR616("QUANTITY")
+5 SET RMPRFDA(661.6,"+1,",6)=RMPR616("VALUE")
+6 SET RMPRFDA(661.6,"+1,",8)=RMPR616("COMMENT")
+7 SET RMPRFDA(661.6,"+1,",9)=RMPR616("USER")
+8 SET RMPRFDA(661.6,"+1,",11)=RMPR6111("ITEM")
+9 SET RMPRFDA(661.6,"+1,",12)=RMPR616("VENDOR")
+10 SET RMPRFDA(661.6,"+1,",13)=RMPR6111("STATION")
+11 SET RMPRFDA(661.6,"+1,",14)=RMPR616("LOCATION")
+12 DO UPDATE^DIE("","RMPRFDA","RMPRIENA","RMPRFME")
+13 LOCK -^RMPR(661.6,"XHDS",RMPR6111("HCPCS"),RMPR616("DATE&TIME"))
+14 IF $DATA(RMPRFME)
SET RMPRRET=1
GOTO CREX
+15 SET RMPR616("IEN")=RMPRIENA(1)
CREX QUIT RMPRRET
+1 ;
+2 ;***** UPD - update existing Transaction (661.6) record
+3 ;
+4 ; Inputs:
+5 ; RMPR616 - Transaction array (see above for CRE)
+6 ; RMPR616("IEN") - ien of rec to update (mandatory)
+7 ; all other elements optional but DATE&TIME
+8 ; and SEQUENCE cannot be changed
+9 ; RMPR6111 - HCPCS array (see above for CRE)
+10 ; all elements optional
+11 ;
+12 ; Outputs:
+13 ; RMPRRET - error code returned by function
+14 ; 0 - no problems
+15 ; 1 - invalid RMPR616("IEN")
+16 ; 2 - FM problem with update
+17 ;
UPD(RMPR616,RMPR6111) ;
+1 NEW RMPRRET,RMPRI,RMPRFDA,RMPRFME,X,Y,DA
+2 SET RMPRRET=0
+3 IF $GET(RMPR616("IEN"))=""
SET RMPRRET=1
GOTO UPDX
+4 SET RMPRI=RMPR616("IEN")_","
+5 if $DATA(RMPR6111("HCPCS"))
SET RMPRFDA(661.6,RMPRI,.01)=RMPR6111("HCPCS")
+6 if $DATA(RMPR616("QUANTITY"))
SET RMPRFDA(661.6,RMPRI,5)=RMPR616("QUANTITY")
+7 if $DATA(RMPR616("VALUE"))
SET RMPRFDA(661.6,RMPRI,6)=RMPR616("VALUE")
+8 if $DATA(RMPR616("COMMENT"))
SET RMPRFDA(661.6,RMPRI,8)=RMPR616("COMMENT")
+9 if $DATA(RMPR616("USER"))
SET RMPRFDA(661.6,RMPRI,9)=RMPR616("USER")
+10 if $DATA(RMPR6111("ITEM"))
SET RMPRFDA(661.6,RMPRI,11)=RMPR6111("ITEM")
+11 if $DATA(RMPR616("VENDOR"))
SET RMPRFDA(661.6,RMPRI,12)=RMPR616("VENDOR")
+12 if $DATA(RMPR616("LOCATION"))
SET RMPRFDA(661.6,RMPRI,14)=RMPR616("LOCATION")
+13 if $DATA(RMPRFDA)
DO FILE^DIE("","RMPRFDA","RMPRFME")
+14 IF $DATA(RMPRFME)
SET RMPRRET=2
GOTO UPDX
UPDX QUIT RMPRRET
+1 ;
+2 ;***** GET - read in 661.6 record
GET(RMPR) ;
+1 NEW RMPRRET,RMPRFME,RMPRIEN,RMPRKEY,RMPRERR,RMPROUP,X,Y,DA,RMPREOF
+2 SET RMPRRET=0
+3 IF $GET(RMPR("IEN"))=""
Begin DoDot:1
+4 IF $GET(RMPR("HCPCS"))=""
SET RMPRRET=1
QUIT
+5 IF $GET(RMPR("DATE&TIME"))=""
SET RMPRRET=2
QUIT
+6 SET RMPRKEY("HCPCS")=RMPR("HCPCS")
+7 SET RMPRKEY("DATE&TIME")=RMPR("DATE&TIME")
+8 SET RMPRERR=$$NEXT^RMPRPIXA(.RMPRKEY,"XHDS","",-1,,.RMPREOF)
+9 IF RMPRERR
SET RMPRRET=3
QUIT
+10 IF '$DATA(RMPRKEY("SEQUENCE"))
SET RMPRRET=1
QUIT
+11 IF RMPRKEY("SEQUENCE")'=1
SET RMPRRET=4
QUIT
+12 SET RMPR("IEN")=RMPRKEY("IEN")
+13 QUIT
End DoDot:1
+14 IF RMPRRET
GOTO GETX
+15 SET RMPRIEN=RMPR("IEN")_","
+16 DO GETS^DIQ(661.6,RMPRIEN,"*","","RMPROUP","RMPRFME")
+17 IF $DATA(RMPRFME)
SET RMPRRET=5
GOTO GETX
+18 SET RMPR("HCPCS")=RMPROUP(661.6,RMPRIEN,.01)
+19 SET RMPR("DATE&TIME")=RMPROUP(661.6,RMPRIEN,2)
+20 SET RMPR("DATE")=$PIECE(RMPR("DATE&TIME"),"@",1)
+21 SET RMPR("TIME")=$PIECE(RMPR("DATE&TIME"),"@",2)
+22 SET RMPR("SEQUENCE")=RMPROUP(661.6,RMPRIEN,3)
+23 SET RMPR("TRAN TYPE")=RMPROUP(661.6,RMPRIEN,4)
+24 SET RMPR("QUANTITY")=RMPROUP(661.6,RMPRIEN,5)
+25 SET RMPR("VALUE")=RMPROUP(661.6,RMPRIEN,6)
+26 SET RMPR("COMMENT")=RMPROUP(661.6,RMPRIEN,8)
+27 SET RMPR("USER")=RMPROUP(661.6,RMPRIEN,9)
+28 SET RMPR("ITEM")=RMPROUP(661.6,RMPRIEN,11)
+29 SET RMPR("VENDOR")=RMPROUP(661.6,RMPRIEN,12)
+30 SET RMPR("STATION")=RMPROUP(661.6,RMPRIEN,13)
+31 SET RMPR("LOCATION")=RMPROUP(661.6,RMPRIEN,14)
GETX QUIT RMPRRET
+1 ;
+2 ;***** ETOI - convert external to internal form
ETOI(RMPRE,RMPRI) ;
+1 NEW RMPRFDA,RMPRIEN,RMPRFDI,RMPRFME,RMPRERR
+2 SET RMPRERR=0
+3 SET RMPRIEN=RMPRE("IEN")_","
+4 DO GETS^DIQ(661.6,RMPRIEN,"*","I","RMPRFDI","RMPRFME")
+5 IF $DATA(RMPRFME)
SET RMPRERR=1
GOTO ETOIX
+6 SET RMPRI("IEN")=RMPRE("IEN")
+7 SET RMPRI("HCPCS")=RMPRFDI(661.6,RMPRIEN,.01,"I")
+8 SET RMPRI("DATE&TIME")=RMPRFDI(661.6,RMPRIEN,2,"I")
+9 SET RMPRI("DATE")=$PIECE(RMPRI("DATE&TIME"),".",1)
+10 SET RMPRI("TIME")=$PIECE(RMPRI("DATE&TIME"),".",2)
+11 SET RMPRI("SEQUENCE")=RMPRFDI(661.6,RMPRIEN,3,"I")
+12 SET RMPRI("TRAN TYPE")=RMPRFDI(661.6,RMPRIEN,4,"I")
+13 SET RMPRI("QUANTITY")=RMPRFDI(661.6,RMPRIEN,5,"I")
+14 SET RMPRI("VALUE")=RMPRFDI(661.6,RMPRIEN,6,"I")
+15 SET RMPRI("COMMENT")=RMPRFDI(661.6,RMPRIEN,8,"I")
+16 SET RMPRI("USER")=RMPRFDI(661.6,RMPRIEN,9,"I")
+17 SET RMPRI("ITEM")=RMPRFDI(661.6,RMPRIEN,11,"I")
+18 SET RMPRI("VENDOR")=RMPRFDI(661.6,RMPRIEN,12,"I")
+19 SET RMPRI("STATION")=RMPRFDI(661.6,RMPRIEN,13,"I")
+20 SET RMPRI("LOCATION")=RMPRFDI(661.6,RMPRIEN,14,"I")
ETOIX QUIT RMPRERR
+1 ;
+2 ; TFLOW - sets RMPR("TRAN FLOW")
TFLOW(RMPR) ;
+1 NEW RMPRFDA,RMPRIEN,RMPRFDI,RMPRFME,RMPRERR,RMPRTYP
+2 SET RMPRERR=0
+3 SET RMPRIEN=RMPR("IEN")_","
+4 SET RMPRFDA(661.6,RMPRIEN,4)=RMPR("TRAN TYPE")
+5 DO VALS^DIE("","RMPRFDA","RMPRFDI","RMPRFME")
+6 IF $DATA(RMPRFME)
SET RMPRERR=1
GOTO TFLOWX
+7 SET RMPRTYP=","_RMPRFDI(661.6,RMPRIEN,4)_","
+8 SET RMPR("TRAN FLOW")=""
+9 IF ",1,8,"[RMPRTYP
SET RMPR("TRAN FLOW")="+"
+10 IF ",2,7,"[RMPRTYP
SET RMPR("TRAN FLOW")=""
+11 IF ",3,4,5,6,"[RMPRTYP
SET RMPR("TRAN FLOW")="-"
+12 IF ",9,"[RMPRTYP
SET RMPR("TRAN FLOW")="="
TFLOWX QUIT RMPRERR
+1 ;
+2 ; DTIEN - sets internal form of DATE/TIME
DTIEN(RMPR) ;
+1 NEW RMPRFDA,RMPRIEN,RMPRFDI,RMPRFME,RMPRERR
+2 SET RMPRERR=0
+3 SET RMPRIEN=RMPR("IEN")_","
+4 DO GETS^DIQ(661.6,RMPRIEN,"*","I","RMPRFDI","RMPRFME")
+5 SET RMPR("DATE&TIME")=RMPRFDI(661.6,RMPRIEN,2,"I")
+6 QUIT RMPRERR
+7 ;
+8 ; STNIEN - sets RMPR("STATION IEN")
STNIEN(RMPR) ;
+1 NEW RMPRFDA,RMPRIEN,RMPRFDI,RMPRFME,RMPRERR
+2 SET RMPRERR=0
+3 SET RMPRIEN=RMPR("IEN")_","
+4 DO GETS^DIQ(661.6,RMPRIEN,"*","I","RMPRFDI","RMPRFME")
+5 IF $DATA(RMPRFME)
SET RMPRERR=1
GOTO STNIENX
+6 SET RMPR("STATION IEN")=RMPRFDI(661.6,RMPRIEN,13,"I")
STNIENX QUIT RMPRERR
+1 ;
+2 ; VNDIEN - sets RMPR("VENDOR IEN")
VNDIEN(RMPR) ;
+1 NEW RMPRFDA,RMPRIEN,RMPRFDI,RMPRFME,RMPRERR
+2 SET RMPRERR=0
+3 IF '$DATA(RMPR("IEN"))
WRITE !!,"*** MISSING POINTER TO VENDOR FILE, PLEASE CHECK FILE #661.11 !!!",!
SET RMPRERR=1
GOTO VNDIENX
+4 SET RMPRIEN=RMPR("IEN")_","
+5 DO GETS^DIQ(661.6,RMPRIEN,"12","I","RMPRFDI","RMPRFME")
+6 IF $DATA(RMPRFME)
SET RMPRERR=1
GOTO VNDIENX
+7 SET RMPR("VENDOR IEN")=RMPRFDI(661.6,RMPRIEN,12,"I")
VNDIENX QUIT RMPRERR
+1 ;
+2 ; DEL - Delete a record
DEL(RMPR6) ;
+1 NEW RMPRFDA,RMPRFME,RMPRERR,RMPRIEN,X,Y,DA
+2 SET RMPRERR=0
+3 IF $GET(RMPR6("IEN"))=""
SET RMPRERR=1
GOTO DELX
+4 SET RMPRIEN=RMPR6("IEN")_","
+5 SET RMPRFDA(661.6,RMPRIEN,.01)="@"
+6 DO FILE^DIE("","RMPRFDA","RMPRFME")
+7 IF $DATA(RMPRFME)
SET RMPRERR=1
DELX QUIT RMPRERR
+1 ;
+2 ; Get the ien for a 2319 patient stock issue record in file 660
IEN60(RMPR6,RMPR60) ;
+1 NEW RMPRERR,RMPRIEN
+2 SET RMPRERR=0
+3 IF $GET(RMPR6("IEN"))=""
SET RMPRERR=1
GOTO IEN60X
+4 SET RMPRIEN=$ORDER(^RMPR(661.63,"B",RMPR6("IEN"),""))
+5 IF RMPRIEN=""
SET RMPRERR=2
GOTO IEN60X
+6 SET RMPR60("IEN")=$PIECE($GET(^RMPR(661.63,RMPRIEN,0)),"^",2)
IEN60X QUIT RMPRERR
