- 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 Feb 19, 2025@00:03:05 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