RMPRPIUC ;HINCIO/ODJ - APIs for file 661.7 ;3/8/01
;;3.0;PROSTHETICS;**61**;Feb 09, 1996
Q
;
;
; Inputs:
; RMPR11 - an array with the following elements...
; RMPR11("STATION IEN") - Station ien (ptr ^DIC(4,)
; RMPR5F("IEN") - Location ien (ptr ^RMPR(661.5,)
; RMPR11("HCPCS") - HCPCS code (eg E0111)
; RMPR11("ITEM") - HCPCS Item number (eg 1)
; RMPR("TRNF QTY") - Quantity Transferred
; RMPR("TRNF VALUE") - Transfer Value
; RMPR("VENDOR IEN") - Vendor ien
;
; Outputs:
; RMPRERR - function return...
; 0 - no errors
; 1 - null Station ien input
; 2 - null Location ien input
; 3 - null HCPCS code input
; 4 - null Item input
; 5 - transfer qty not greater than 0
; 6 - problem with 661.7 file
TRNF(RMPR11,RMPR5F,RMPR5T,RMPR) ;
N RMPRERR,RMPRK,RMPROLD,RMPREOF,RMPR7,RMPR7I,RMPRIBAL,RMPRVBAL
N RMPRUVAL,RMPR7TI,RMPRTQTY,RMPRTVAL,RMPRTIEN,RMPR6
S RMPRERR=0
S RMPRK("STATION")=$G(RMPR11("STATION IEN"))
I RMPRK("STATION")="" S RMPRERR=1 G TRNFX
S RMPRK("UNIT")=$G(RMPR5F("UNIT"))
S RMPRK("LOCATION")=$G(RMPR5F("IEN"))
I RMPRK("LOCATION")="" S RMPRERR=2 G TRNFX
S RMPRK("HCPCS")=$G(RMPR11("HCPCS"))
I RMPRK("HCPCS")="" S RMPRERR=3 G TRNFX
S RMPRK("ITEM")=$G(RMPR11("ITEM"))
I RMPRK("ITEM")="" S RMPRERR=4 G TRNFX
I '+$G(RMPR("TRNF QTY")) S RMPRERR=5 G TRNFX
S RMPRIBAL=RMPR("TRNF QTY") ; init transfer qty. balance
S RMPRVBAL=+$G(RMPR("TRNF VALUE")) ; init transfer value balance
S RMPRUVAL=RMPRVBAL/RMPRIBAL ; unit cost per transferred item
L +^RMPR(661.7,"XSLHIDS",RMPR11("STATION IEN"),RMPR5F("IEN"),RMPR11("HCPCS"),RMPR11("ITEM"))
L +^RMPR(661.7,"XSLHIDS",RMPR11("STATION IEN"),RMPR5T("IEN"),RMPR11("HCPCS"),RMPR11("ITEM"))
;
; Loop on all records for Stn, Loc, HCPCS and Item until stock
; transferred
TRNFA S RMPRERR=$$NEXT^RMPRPIXE(.RMPRK,"XSLHIDS","",1,.RMPROLD,.RMPREOF)
I RMPRERR S RMPRERR=6 G TRNFU
I RMPREOF G TRNFU
I RMPRK("ITEM")'=RMPROLD("ITEM") G TRNFU
I RMPRK("HCPCS")'=RMPROLD("HCPCS") G TRNFU
I RMPRK("LOCATION")'=RMPROLD("LOCATION") G TRNFU
S RMPRK("UNIT")=$G(RMPROLD("UNIT"))
I RMPRK("STATION")'=RMPROLD("STATION") G TRNFU
K RMPR7 M RMPR7=RMPRK
S RMPRERR=$$GET^RMPRPIX7(.RMPR7) ; read in current stock rec.
I RMPRERR S RMPRERR=6 G TRNFU
K RMPR6 M RMPR6=RMPRK S RMPR6("IEN")=""
S RMPRERR=$$GET^RMPRPIX6(.RMPR6)
S RMPRERR=$$VNDIEN^RMPRPIX6(.RMPR6)
I RMPR6("VENDOR IEN")'=RMPR("VENDOR IEN") G TRNFA
K RMPR7TI,RMPR7I
S RMPRERR=$$ETOI^RMPRPIX7(.RMPR7,.RMPR7I)
I RMPRERR S RMPRERR=6 G TRNFU
S RMPR7TI("DATE&TIME")=RMPR7I("DATE&TIME")
S RMPR7TI("SEQUENCE")=RMPR7I("SEQUENCE")
K RMPR7I
S RMPR7I("IEN")=RMPR7("IEN")
S RMPR7I("QUANTITY")=RMPR7("QUANTITY")
S RMPR7I("VALUE")=RMPR7("VALUE")
;
; If issued balance less than on-hand quantity then update
; the on-hand record
I RMPRIBAL<RMPR7I("QUANTITY") D
. S RMPR7I("QUANTITY")=RMPR7I("QUANTITY")-RMPRIBAL
. S RMPR7I("VALUE")=RMPR7I("VALUE")-RMPRVBAL
. S RMPRTQTY=RMPRIBAL
. S RMPRTVAL=RMPRVBAL
. S RMPRERR=$$UPD^RMPRPIX7(.RMPR7I,)
. S RMPRIBAL=0
. Q
;
; If issued balance not less than on-hand quantity then delete
; the on-hand record
E D
. S RMPRIBAL=RMPRIBAL-RMPR7I("QUANTITY")
. S RMPRTQTY=RMPR7I("QUANTITY")
. S RMPRTVAL=$J(RMPR7I("QUANTITY")*RMPRUVAL,0,2)
. S RMPRVBAL=RMPRVBAL-RMPRTVAL
. S RMPRERR=$$DEL^RMPRPIX7(.RMPR7I)
. Q
I RMPRERR S RMPRERR=6 G TRNFU
;
; Increase the 'TO' transfer record
S RMPRTIEN=$O(^RMPR(661.7,"XSLHIDS",RMPR11("STATION IEN"),RMPR5T("IEN"),RMPR11("HCPCS"),RMPR11("ITEM"),RMPR7TI("DATE&TIME"),RMPR7TI("SEQUENCE"),""))
I RMPRTIEN="" D
. S RMPR7TI("IEN")=""
. S RMPR7TI("QUANTITY")=RMPRTQTY
. S RMPR7TI("VALUE")=RMPRTVAL
. S RMPR7TI("LOCATION")=RMPR5T("IEN")
. S RMPR7TI("UNIT")=$G(RMPR5T("UNIT"))
. S RMPRERR=$$CRE^RMPRPIX7(.RMPR7TI,.RMPR11)
. I RMPRERR S RMPRERR=6
. Q
E D
. K RMPR7
. S RMPR7("IEN")=RMPRTIEN
. S RMPRERR=$$GET^RMPRPIX7(.RMPR7)
. I RMPRERR S RMPRERR=6 Q
. K RMPR7TI
. S RMPR7TI("IEN")=RMPRTIEN
. S RMPR7TI("QUANTITY")=RMPR7("QUANTITY")+RMPRTQTY
. S RMPR7TI("UNIT")=$G(RMPR5T("UNIT"))
. S RMPR7TI("VALUE")=RMPR7("VALUE")+RMPRTVAL
. S RMPRERR=$$UPD^RMPRPIX7(.RMPR7TI,.RMPR11)
. I RMPRERR S RMPRERR=6 Q
. Q
I RMPRERR G TRNFU
G:RMPRIBAL TRNFA ; next stock rec. if still got transfer balance
;
; exit points
TRNFU L -^RMPR(661.7,"XSLHIDS",RMPR11("STATION IEN"),RMPR5F("IEN"),RMPR11("HCPCS"),RMPR11("ITEM"))
L -^RMPR(661.7,"XSLHIDS",RMPR11("STATION IEN"),RMPR5T("IEN"),RMPR11("HCPCS"),RMPR11("ITEM"))
TRNFX Q RMPRERR
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRMPRPIUC 4710 printed Sep 23, 2025@20:12:32 Page 2
RMPRPIUC ;HINCIO/ODJ - APIs for file 661.7 ;3/8/01
+1 ;;3.0;PROSTHETICS;**61**;Feb 09, 1996
+2 QUIT
+3 ;
+4 ;
+5 ; Inputs:
+6 ; RMPR11 - an array with the following elements...
+7 ; RMPR11("STATION IEN") - Station ien (ptr ^DIC(4,)
+8 ; RMPR5F("IEN") - Location ien (ptr ^RMPR(661.5,)
+9 ; RMPR11("HCPCS") - HCPCS code (eg E0111)
+10 ; RMPR11("ITEM") - HCPCS Item number (eg 1)
+11 ; RMPR("TRNF QTY") - Quantity Transferred
+12 ; RMPR("TRNF VALUE") - Transfer Value
+13 ; RMPR("VENDOR IEN") - Vendor ien
+14 ;
+15 ; Outputs:
+16 ; RMPRERR - function return...
+17 ; 0 - no errors
+18 ; 1 - null Station ien input
+19 ; 2 - null Location ien input
+20 ; 3 - null HCPCS code input
+21 ; 4 - null Item input
+22 ; 5 - transfer qty not greater than 0
+23 ; 6 - problem with 661.7 file
TRNF(RMPR11,RMPR5F,RMPR5T,RMPR) ;
+1 NEW RMPRERR,RMPRK,RMPROLD,RMPREOF,RMPR7,RMPR7I,RMPRIBAL,RMPRVBAL
+2 NEW RMPRUVAL,RMPR7TI,RMPRTQTY,RMPRTVAL,RMPRTIEN,RMPR6
+3 SET RMPRERR=0
+4 SET RMPRK("STATION")=$GET(RMPR11("STATION IEN"))
+5 IF RMPRK("STATION")=""
SET RMPRERR=1
GOTO TRNFX
+6 SET RMPRK("UNIT")=$GET(RMPR5F("UNIT"))
+7 SET RMPRK("LOCATION")=$GET(RMPR5F("IEN"))
+8 IF RMPRK("LOCATION")=""
SET RMPRERR=2
GOTO TRNFX
+9 SET RMPRK("HCPCS")=$GET(RMPR11("HCPCS"))
+10 IF RMPRK("HCPCS")=""
SET RMPRERR=3
GOTO TRNFX
+11 SET RMPRK("ITEM")=$GET(RMPR11("ITEM"))
+12 IF RMPRK("ITEM")=""
SET RMPRERR=4
GOTO TRNFX
+13 IF '+$GET(RMPR("TRNF QTY"))
SET RMPRERR=5
GOTO TRNFX
+14 ; init transfer qty. balance
SET RMPRIBAL=RMPR("TRNF QTY")
+15 ; init transfer value balance
SET RMPRVBAL=+$GET(RMPR("TRNF VALUE"))
+16 ; unit cost per transferred item
SET RMPRUVAL=RMPRVBAL/RMPRIBAL
+17 LOCK +^RMPR(661.7,"XSLHIDS",RMPR11("STATION IEN"),RMPR5F("IEN"),RMPR11("HCPCS"),RMPR11("ITEM"))
+18 LOCK +^RMPR(661.7,"XSLHIDS",RMPR11("STATION IEN"),RMPR5T("IEN"),RMPR11("HCPCS"),RMPR11("ITEM"))
+19 ;
+20 ; Loop on all records for Stn, Loc, HCPCS and Item until stock
+21 ; transferred
TRNFA SET RMPRERR=$$NEXT^RMPRPIXE(.RMPRK,"XSLHIDS","",1,.RMPROLD,.RMPREOF)
+1 IF RMPRERR
SET RMPRERR=6
GOTO TRNFU
+2 IF RMPREOF
GOTO TRNFU
+3 IF RMPRK("ITEM")'=RMPROLD("ITEM")
GOTO TRNFU
+4 IF RMPRK("HCPCS")'=RMPROLD("HCPCS")
GOTO TRNFU
+5 IF RMPRK("LOCATION")'=RMPROLD("LOCATION")
GOTO TRNFU
+6 SET RMPRK("UNIT")=$GET(RMPROLD("UNIT"))
+7 IF RMPRK("STATION")'=RMPROLD("STATION")
GOTO TRNFU
+8 KILL RMPR7
MERGE RMPR7=RMPRK
+9 ; read in current stock rec.
SET RMPRERR=$$GET^RMPRPIX7(.RMPR7)
+10 IF RMPRERR
SET RMPRERR=6
GOTO TRNFU
+11 KILL RMPR6
MERGE RMPR6=RMPRK
SET RMPR6("IEN")=""
+12 SET RMPRERR=$$GET^RMPRPIX6(.RMPR6)
+13 SET RMPRERR=$$VNDIEN^RMPRPIX6(.RMPR6)
+14 IF RMPR6("VENDOR IEN")'=RMPR("VENDOR IEN")
GOTO TRNFA
+15 KILL RMPR7TI,RMPR7I
+16 SET RMPRERR=$$ETOI^RMPRPIX7(.RMPR7,.RMPR7I)
+17 IF RMPRERR
SET RMPRERR=6
GOTO TRNFU
+18 SET RMPR7TI("DATE&TIME")=RMPR7I("DATE&TIME")
+19 SET RMPR7TI("SEQUENCE")=RMPR7I("SEQUENCE")
+20 KILL RMPR7I
+21 SET RMPR7I("IEN")=RMPR7("IEN")
+22 SET RMPR7I("QUANTITY")=RMPR7("QUANTITY")
+23 SET RMPR7I("VALUE")=RMPR7("VALUE")
+24 ;
+25 ; If issued balance less than on-hand quantity then update
+26 ; the on-hand record
+27 IF RMPRIBAL<RMPR7I("QUANTITY")
Begin DoDot:1
+28 SET RMPR7I("QUANTITY")=RMPR7I("QUANTITY")-RMPRIBAL
+29 SET RMPR7I("VALUE")=RMPR7I("VALUE")-RMPRVBAL
+30 SET RMPRTQTY=RMPRIBAL
+31 SET RMPRTVAL=RMPRVBAL
+32 SET RMPRERR=$$UPD^RMPRPIX7(.RMPR7I,)
+33 SET RMPRIBAL=0
+34 QUIT
End DoDot:1
+35 ;
+36 ; If issued balance not less than on-hand quantity then delete
+37 ; the on-hand record
+38 IF '$TEST
Begin DoDot:1
+39 SET RMPRIBAL=RMPRIBAL-RMPR7I("QUANTITY")
+40 SET RMPRTQTY=RMPR7I("QUANTITY")
+41 SET RMPRTVAL=$JUSTIFY(RMPR7I("QUANTITY")*RMPRUVAL,0,2)
+42 SET RMPRVBAL=RMPRVBAL-RMPRTVAL
+43 SET RMPRERR=$$DEL^RMPRPIX7(.RMPR7I)
+44 QUIT
End DoDot:1
+45 IF RMPRERR
SET RMPRERR=6
GOTO TRNFU
+46 ;
+47 ; Increase the 'TO' transfer record
+48 SET RMPRTIEN=$ORDER(^RMPR(661.7,"XSLHIDS",RMPR11("STATION IEN"),RMPR5T("IEN"),RMPR11("HCPCS"),RMPR11("ITEM"),RMPR7TI("DATE&TIME"),RMPR7TI("SEQUENCE"),""))
+49 IF RMPRTIEN=""
Begin DoDot:1
+50 SET RMPR7TI("IEN")=""
+51 SET RMPR7TI("QUANTITY")=RMPRTQTY
+52 SET RMPR7TI("VALUE")=RMPRTVAL
+53 SET RMPR7TI("LOCATION")=RMPR5T("IEN")
+54 SET RMPR7TI("UNIT")=$GET(RMPR5T("UNIT"))
+55 SET RMPRERR=$$CRE^RMPRPIX7(.RMPR7TI,.RMPR11)
+56 IF RMPRERR
SET RMPRERR=6
+57 QUIT
End DoDot:1
+58 IF '$TEST
Begin DoDot:1
+59 KILL RMPR7
+60 SET RMPR7("IEN")=RMPRTIEN
+61 SET RMPRERR=$$GET^RMPRPIX7(.RMPR7)
+62 IF RMPRERR
SET RMPRERR=6
QUIT
+63 KILL RMPR7TI
+64 SET RMPR7TI("IEN")=RMPRTIEN
+65 SET RMPR7TI("QUANTITY")=RMPR7("QUANTITY")+RMPRTQTY
+66 SET RMPR7TI("UNIT")=$GET(RMPR5T("UNIT"))
+67 SET RMPR7TI("VALUE")=RMPR7("VALUE")+RMPRTVAL
+68 SET RMPRERR=$$UPD^RMPRPIX7(.RMPR7TI,.RMPR11)
+69 IF RMPRERR
SET RMPRERR=6
QUIT
+70 QUIT
End DoDot:1
+71 IF RMPRERR
GOTO TRNFU
+72 ; next stock rec. if still got transfer balance
if RMPRIBAL
GOTO TRNFA
+73 ;
+74 ; exit points
TRNFU LOCK -^RMPR(661.7,"XSLHIDS",RMPR11("STATION IEN"),RMPR5F("IEN"),RMPR11("HCPCS"),RMPR11("ITEM"))
+1 LOCK -^RMPR(661.7,"XSLHIDS",RMPR11("STATION IEN"),RMPR5T("IEN"),RMPR11("HCPCS"),RMPR11("ITEM"))
TRNFX QUIT RMPRERR
