101 lines
3.3 KiB
Mathematica
101 lines
3.3 KiB
Mathematica
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
|