RMPRPI07.m

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 ---RMPRPI07   3444     printed  Feb 19, 2025@00:02:28                                                                                                                                                                                                    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