source: WorldVistAEHR/trunk/r/PROSTHETICS-RMPR-RMPO-RMPS/RMPRPI07.m@ 1111

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