source: FOIAVistA/trunk/r/PROSTHETICS-RMPR-RMPO-RMPS/RMPRPI07.m@ 696

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