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