RMPRPI07 ;HINCIO/ODJ - PIP APIs ;3/8/01
;;3.0;PROSTHETICS;**61**;Feb 09, 1996
Q
;
; LOC - Build workfile for Quantity on hand by location
LOC(RMPRNM,RMPRSTN,RMPRLOCA,RMPRSRC,RMPRSDT,RMPREDT) ;
N RMPRERR,RMPRL,RMPRALL,RMPRDT,RMPRI,RMPR6,RMPR6I,RMPRSTR,RMPR11
N RMPR11I,RMPR7,RMPREOF,RMPRDAYS,RMPR7I
N X1,X2,X
S RMPRERR=0
I $G(RMPRSTN)="" S RMPRERR=1 G LOCX
I $G(RMPRNM)="" S RMPRNM="RMPRPI07"
K ^TMP($J,RMPRNM)
S RMPRALL=$S($G(RMPRLOCA)="*":1,1:0)
I $G(RMPRSRC)="" S RMPRSRC="C"
I $G(RMPREDT)="" D NOW^%DTC S RMPREDT=X
I $G(RMPRSDT)="" D
. S X1=RMPREDT,X2=-89 D C^%DTC S RMPRSDT=X
. Q
S X2=RMPRSDT,X1=RMPREDT D ^%DTC S RMPRDAYS=X+1
;
; First loop on transaction file (661.6) for issues
S RMPRL=""
LOC1 I RMPRALL D
. S RMPRL=$O(^RMPR(661.6,"ASLD",RMPRSTN,RMPRL))
. Q
E D
. S RMPRL=$O(RMPRLOCA(RMPRL))
. Q
I RMPRL="" G LOC11
I RMPRSDT="" D
. S RMPRDT=$O(^RMPR(661.6,"ASLD",RMPRSTN,RMPRL,""))
. Q
E D
. I $D(^RMPR(661.6,"ASLD",RMPRSTN,RMPRL,RMPRSDT)) S RMPRDT=RMPRSDT Q
. S RMPRDT=$O(^RMPR(661.6,"ASLD",RMPRSTN,RMPRL,RMPRSDT))
. Q
LOC2 I RMPRDT="" G LOC1
I $P(RMPRDT,".",1)>RMPREDT G LOC1
S RMPRI=""
LOC3 S RMPRI=$O(^RMPR(661.6,"ASLD",RMPRSTN,RMPRL,RMPRDT,RMPRI))
I RMPRI="" D G LOC2
. S RMPRDT=$O(^RMPR(661.6,"ASLD",RMPRSTN,RMPRL,RMPRDT))
. Q
K RMPR6
S RMPR6("IEN")=RMPRI
S RMPRERR=$$GET^RMPRPIX6(.RMPR6)
I RMPRERR S RMPRERR=1 G LOCX
S RMPRERR=$$ETOI^RMPRPIX6(.RMPR6,.RMPR6I) ;read trans. rec. (661.6)
I RMPRERR S RMPRERR=2 G LOCX
I RMPR6I("TRAN TYPE")'=3 G LOC3 ;not patient issue
K RMPR11
S RMPR11("STATION")=RMPRSTN
S RMPR11("HCPCS")=RMPR6("HCPCS")
S RMPR11("ITEM")=RMPR6("ITEM")
S RMPRERR=$$GET^RMPRPIX1(.RMPR11) ;read in Item rec. (661.11)
I RMPRERR S RMPRERR=3 G LOCX
S RMPRERR=$$ETOI^RMPRPIX1(.RMPR11,.RMPR11I)
I RMPRERR S RMPRERR=4 G LOCX
I RMPR11I("SOURCE")'=RMPRSRC G LOC3 ;not required source
S RMPRSTR=$G(^TMP($J,RMPRNM,RMPRL,RMPR6("HCPCS"),RMPR11("DESCRIPTION"),RMPR6("ITEM")))
S $P(RMPRSTR,"^",1)=RMPR6("QUANTITY")+$P(RMPRSTR,"^",1)
S $P(RMPRSTR,"^",2)=RMPR6("VALUE")+$P(RMPRSTR,"^",2)
S ^TMP($J,RMPRNM,RMPRL,RMPR6("HCPCS"),RMPR11("DESCRIPTION"),RMPR6("ITEM"))=RMPRSTR
G LOC3
;
; Second loop on Current Stock (661.7) for quantity on hand
S RMPRL=""
LOC11 I RMPRALL D
. S RMPRL=$O(^RMPR(661.7,"XSLHIDS",RMPRSTN,RMPRL))
. Q
E D
. S RMPRL=$O(RMPRLOCA(RMPRL))
. Q
I RMPRL="" G LOCX
K RMPR7I
S RMPR7I("STATION")=RMPRSTN
S RMPR7I("LOCATION")=RMPRL
LOC12 S RMPRERR=$$NEXT^RMPRPIXE(.RMPR7I,"XSLHIDS","",1,.RMPROLD,.RMPREOF)
I RMPREOF G LOC11
I RMPR7I("STATION")'=RMPRSTN G LOC11
I RMPR7I("LOCATION")'=RMPRL G LOC11
K RMPR7
S RMPR7("IEN")=RMPR7I("IEN")
S RMPRERR=$$GET^RMPRPIX7(.RMPR7) ;read in cur. stock rec.
K RMPR11,RMPR11I
S RMPR11("STATION")=RMPRSTN
S RMPR11("HCPCS")=RMPR7("HCPCS")
S RMPR11("ITEM")=RMPR7("ITEM")
S RMPRERR=$$GET^RMPRPIX1(.RMPR11) ;read in Item rec. (661.11)
I RMPRERR S RMPRERR=99 G LOCX
S RMPRERR=$$ETOI^RMPRPIX1(.RMPR11,.RMPR11I)
I RMPRERR S RMPRERR=99 G LOCX
I RMPR11I("SOURCE")'=RMPRSRC G LOC12 ;not required source
S RMPRSTR=$G(^TMP($J,RMPRNM,RMPRL,RMPR7("HCPCS"),RMPR11("DESCRIPTION"),RMPR7("ITEM")))
S $P(RMPRSTR,"^",5)=RMPR7("QUANTITY")+$P(RMPRSTR,"^",5)
S $P(RMPRSTR,"^",6)=RMPR7("VALUE")+$P(RMPRSTR,"^",6)
S ^TMP($J,RMPRNM,RMPRL,RMPR7("HCPCS"),RMPR11("DESCRIPTION"),RMPR7("ITEM"))=RMPRSTR
G LOC12
LOCX Q RMPRERR
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRMPRPI07 3444 printed Dec 13, 2024@02:36 Page 2
RMPRPI07 ;HINCIO/ODJ - PIP APIs ;3/8/01
+1 ;;3.0;PROSTHETICS;**61**;Feb 09, 1996
+2 QUIT
+3 ;
+4 ; LOC - Build workfile for Quantity on hand by location
LOC(RMPRNM,RMPRSTN,RMPRLOCA,RMPRSRC,RMPRSDT,RMPREDT) ;
+1 NEW RMPRERR,RMPRL,RMPRALL,RMPRDT,RMPRI,RMPR6,RMPR6I,RMPRSTR,RMPR11
+2 NEW RMPR11I,RMPR7,RMPREOF,RMPRDAYS,RMPR7I
+3 NEW X1,X2,X
+4 SET RMPRERR=0
+5 IF $GET(RMPRSTN)=""
SET RMPRERR=1
GOTO LOCX
+6 IF $GET(RMPRNM)=""
SET RMPRNM="RMPRPI07"
+7 KILL ^TMP($JOB,RMPRNM)
+8 SET RMPRALL=$SELECT($GET(RMPRLOCA)="*":1,1:0)
+9 IF $GET(RMPRSRC)=""
SET RMPRSRC="C"
+10 IF $GET(RMPREDT)=""
DO NOW^%DTC
SET RMPREDT=X
+11 IF $GET(RMPRSDT)=""
Begin DoDot:1
+12 SET X1=RMPREDT
SET X2=-89
DO C^%DTC
SET RMPRSDT=X
+13 QUIT
End DoDot:1
+14 SET X2=RMPRSDT
SET X1=RMPREDT
DO ^%DTC
SET RMPRDAYS=X+1
+15 ;
+16 ; First loop on transaction file (661.6) for issues
+17 SET RMPRL=""
LOC1 IF RMPRALL
Begin DoDot:1
+1 SET RMPRL=$ORDER(^RMPR(661.6,"ASLD",RMPRSTN,RMPRL))
+2 QUIT
End DoDot:1
+3 IF '$TEST
Begin DoDot:1
+4 SET RMPRL=$ORDER(RMPRLOCA(RMPRL))
+5 QUIT
End DoDot:1
+6 IF RMPRL=""
GOTO LOC11
+7 IF RMPRSDT=""
Begin DoDot:1
+8 SET RMPRDT=$ORDER(^RMPR(661.6,"ASLD",RMPRSTN,RMPRL,""))
+9 QUIT
End DoDot:1
+10 IF '$TEST
Begin DoDot:1
+11 IF $DATA(^RMPR(661.6,"ASLD",RMPRSTN,RMPRL,RMPRSDT))
SET RMPRDT=RMPRSDT
QUIT
+12 SET RMPRDT=$ORDER(^RMPR(661.6,"ASLD",RMPRSTN,RMPRL,RMPRSDT))
+13 QUIT
End DoDot:1
LOC2 IF RMPRDT=""
GOTO LOC1
+1 IF $PIECE(RMPRDT,".",1)>RMPREDT
GOTO LOC1
+2 SET RMPRI=""
LOC3 SET RMPRI=$ORDER(^RMPR(661.6,"ASLD",RMPRSTN,RMPRL,RMPRDT,RMPRI))
+1 IF RMPRI=""
Begin DoDot:1
+2 SET RMPRDT=$ORDER(^RMPR(661.6,"ASLD",RMPRSTN,RMPRL,RMPRDT))
+3 QUIT
End DoDot:1
GOTO LOC2
+4 KILL RMPR6
+5 SET RMPR6("IEN")=RMPRI
+6 SET RMPRERR=$$GET^RMPRPIX6(.RMPR6)
+7 IF RMPRERR
SET RMPRERR=1
GOTO LOCX
+8 ;read trans. rec. (661.6)
SET RMPRERR=$$ETOI^RMPRPIX6(.RMPR6,.RMPR6I)
+9 IF RMPRERR
SET RMPRERR=2
GOTO LOCX
+10 ;not patient issue
IF RMPR6I("TRAN TYPE")'=3
GOTO LOC3
+11 KILL RMPR11
+12 SET RMPR11("STATION")=RMPRSTN
+13 SET RMPR11("HCPCS")=RMPR6("HCPCS")
+14 SET RMPR11("ITEM")=RMPR6("ITEM")
+15 ;read in Item rec. (661.11)
SET RMPRERR=$$GET^RMPRPIX1(.RMPR11)
+16 IF RMPRERR
SET RMPRERR=3
GOTO LOCX
+17 SET RMPRERR=$$ETOI^RMPRPIX1(.RMPR11,.RMPR11I)
+18 IF RMPRERR
SET RMPRERR=4
GOTO LOCX
+19 ;not required source
IF RMPR11I("SOURCE")'=RMPRSRC
GOTO LOC3
+20 SET RMPRSTR=$GET(^TMP($JOB,RMPRNM,RMPRL,RMPR6("HCPCS"),RMPR11("DESCRIPTION"),RMPR6("ITEM")))
+21 SET $PIECE(RMPRSTR,"^",1)=RMPR6("QUANTITY")+$PIECE(RMPRSTR,"^",1)
+22 SET $PIECE(RMPRSTR,"^",2)=RMPR6("VALUE")+$PIECE(RMPRSTR,"^",2)
+23 SET ^TMP($JOB,RMPRNM,RMPRL,RMPR6("HCPCS"),RMPR11("DESCRIPTION"),RMPR6("ITEM"))=RMPRSTR
+24 GOTO LOC3
+25 ;
+26 ; Second loop on Current Stock (661.7) for quantity on hand
+27 SET RMPRL=""
LOC11 IF RMPRALL
Begin DoDot:1
+1 SET RMPRL=$ORDER(^RMPR(661.7,"XSLHIDS",RMPRSTN,RMPRL))
+2 QUIT
End DoDot:1
+3 IF '$TEST
Begin DoDot:1
+4 SET RMPRL=$ORDER(RMPRLOCA(RMPRL))
+5 QUIT
End DoDot:1
+6 IF RMPRL=""
GOTO LOCX
+7 KILL RMPR7I
+8 SET RMPR7I("STATION")=RMPRSTN
+9 SET RMPR7I("LOCATION")=RMPRL
LOC12 SET RMPRERR=$$NEXT^RMPRPIXE(.RMPR7I,"XSLHIDS","",1,.RMPROLD,.RMPREOF)
+1 IF RMPREOF
GOTO LOC11
+2 IF RMPR7I("STATION")'=RMPRSTN
GOTO LOC11
+3 IF RMPR7I("LOCATION")'=RMPRL
GOTO LOC11
+4 KILL RMPR7
+5 SET RMPR7("IEN")=RMPR7I("IEN")
+6 ;read in cur. stock rec.
SET RMPRERR=$$GET^RMPRPIX7(.RMPR7)
+7 KILL RMPR11,RMPR11I
+8 SET RMPR11("STATION")=RMPRSTN
+9 SET RMPR11("HCPCS")=RMPR7("HCPCS")
+10 SET RMPR11("ITEM")=RMPR7("ITEM")
+11 ;read in Item rec. (661.11)
SET RMPRERR=$$GET^RMPRPIX1(.RMPR11)
+12 IF RMPRERR
SET RMPRERR=99
GOTO LOCX
+13 SET RMPRERR=$$ETOI^RMPRPIX1(.RMPR11,.RMPR11I)
+14 IF RMPRERR
SET RMPRERR=99
GOTO LOCX
+15 ;not required source
IF RMPR11I("SOURCE")'=RMPRSRC
GOTO LOC12
+16 SET RMPRSTR=$GET(^TMP($JOB,RMPRNM,RMPRL,RMPR7("HCPCS"),RMPR11("DESCRIPTION"),RMPR7("ITEM")))
+17 SET $PIECE(RMPRSTR,"^",5)=RMPR7("QUANTITY")+$PIECE(RMPRSTR,"^",5)
+18 SET $PIECE(RMPRSTR,"^",6)=RMPR7("VALUE")+$PIECE(RMPRSTR,"^",6)
+19 SET ^TMP($JOB,RMPRNM,RMPRL,RMPR7("HCPCS"),RMPR11("DESCRIPTION"),RMPR7("ITEM"))=RMPRSTR
+20 GOTO LOC12
LOCX QUIT RMPRERR
