RMPRPIUB.m

RMPRPIUB ;HINCIO/ODJ - APIs for file 661.7 ;3/8/01

 ;;3.0;PROSTHETICS;**61**;Feb 09, 1996

 Q

 ;

 ;

 ; Inputs:

 ;    RMPR - an array with the following elements...

 ;    RMPR("STATION IEN")  - Station ien (ptr ^DIC(4,)

 ;    RMPR("LOCATION IEN") - Location ien (ptr ^RMPR(661.5,)

 ;    RMPR("HCPCS")        - HCPCS code (eg E0111)

 ;    RMPR("ITEM")         - HCPCS Item number (eg 1)

 ;    RMPR("ISSUED QTY")   - Quantity Issued

 ;    RMPR("ISSUED VALUE") - Issue Value

 ;

 ;    RMPRERR - function return...

 ;               0 - no errors

 ;               1 - null Station ien input

 ;               2 - null Location ien input

 ;               3 - null HCPCS code input

 ;               4 - null Item input

 ;               5 - issued qty not greater than 0

 ;               6 - problem with 661.7 file

FIFO(RMPR) ;

 N RMPRERR,RMPRK,RMPROLD,RMPREOF,RMPR7,RMPR7I,RMPRIBAL,RMPRVBAL

 N RMPRUVAL

 S RMPRERR=0

 S RMPRK("STATION")=$G(RMPR("STATION IEN"))

 I RMPRK("STATION")="" S RMPRERR=1 G FIFOX

 S RMPRK("LOCATION")=$G(RMPR("LOCATION IEN"))

 I RMPRK("LOCATION")="" S RMPRERR=2 G FIFOX

 S RMPRK("HCPCS")=$G(RMPR("HCPCS"))

 I RMPRK("HCPCS")="" S RMPRERR=3 G FIFOX

 S RMPRK("ITEM")=$G(RMPR("ITEM"))

 S RMPRK("IEN")=$G(RMPR("IEN"))

 S RMPRK("DATE&TIME")=$G(RMPR("DATE&TIME"))

 I RMPRK("ITEM")="" S RMPRERR=4 G FIFOX

 I '+$G(RMPR("ISSUED QTY")) S RMPRERR=5 G FIFOX

 S RMPRIBAL=RMPR("ISSUED QTY") ; init issued qty. balance

 S RMPRVBAL=+$G(RMPR("ISSUED VALUE")) ; init issue value balance

 S RMPRUVAL=RMPRVBAL/RMPRIBAL ; unit cost per issued item

 L +^RMPR(661.7,"XSLHIDS",RMPR("STATION IEN"),RMPR("LOCATION IEN"),RMPR("HCPCS"),RMPR("ITEM"))

 G PASS

 ;

 ; Loop on all records for Stn, Loc, HCPCS and Item until stock

 ; depleted by the issued amount

FIFOA S RMPRERR=$$NEXT^RMPRPIXE(.RMPRK,"XSLHIDS","",1,.RMPROLD,.RMPREOF)

 I RMPRERR S RMPRERR=6 G FIFOU

 I RMPREOF G FIFOU

 I RMPRK("ITEM")'=RMPROLD("ITEM") G FIFOU

 I RMPRK("HCPCS")'=RMPROLD("HCPCS") G FIFOU

 I RMPRK("LOCATION")'=RMPROLD("LOCATION") G FIFOU

 I RMPRK("STATION")'=RMPROLD("STATION") G FIFOU

PASS K RMPR7 M RMPR7=RMPRK

 S RMPRERR=$$GET^RMPRPIX7(.RMPR7) ; read in current stock rec.

 I RMPRERR S RMPRERR=6 G FIFOU

 K RMPR7I

 S RMPR7I("IEN")=RMPR7("IEN")

 S RMPR7I("QUANTITY")=RMPR7("QUANTITY")

 S RMPR7I("VALUE")=RMPR7("VALUE")

 ;

 ; If issued balance less than on-hand quantity then update

 ; the on-hand record

 I RMPRIBAL<RMPR7I("QUANTITY") D

 . S RMPR7I("QUANTITY")=RMPR7I("QUANTITY")-RMPRIBAL

 . S RMPR7I("VALUE")=RMPR7I("VALUE")-RMPRVBAL

 . S RMPRERR=$$UPD^RMPRPIX7(.RMPR7I,)

 . S RMPRIBAL=0

 . Q

 ;

 ; If issued balance not less than on-hand quantity the delete

 ; the on-hand record

 E  D

 . S RMPRIBAL=RMPRIBAL-RMPR7I("QUANTITY")

 . S RMPRVBAL=RMPRVBAL-($J(RMPR7I("QUANTITY")*RMPRUVAL,0,2))

 . S RMPRERR=$$DEL^RMPRPIX7(.RMPR7I)

 . Q

 I RMPRERR S RMPRERR=6 G FIFOU

 G:RMPRIBAL FIFOA ; next stock rec. if still got issue balance

 ;

 ; exit points

FIFOU L -^RMPR(661.7,"XSLHIDS",RMPR("STATION IEN"),RMPR("LOCATION IEN"),RMPR("HCPCS"),RMPR("ITEM"))

FIFOX Q RMPRERR

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---RMPRPIUB   3108     printed  Apr 09, 2024@21:36:39                                                                                                                                                                                                    Page 2

RMPRPIUB  ;HINCIO/ODJ - APIs for file 661.7 ;3/8/01

 +1       ;;3.0;PROSTHETICS;**61**;Feb 09, 1996

 +2        QUIT 

 +3       ;

 +4       ;

 +5       ; Inputs:

 +6       ;    RMPR - an array with the following elements...

 +7       ;    RMPR("STATION IEN")  - Station ien (ptr ^DIC(4,)

 +8       ;    RMPR("LOCATION IEN") - Location ien (ptr ^RMPR(661.5,)

 +9       ;    RMPR("HCPCS")        - HCPCS code (eg E0111)

 +10      ;    RMPR("ITEM")         - HCPCS Item number (eg 1)

 +11      ;    RMPR("ISSUED QTY")   - Quantity Issued

 +12      ;    RMPR("ISSUED VALUE") - Issue Value

 +13      ;

 +14      ;    RMPRERR - function return...

 +15      ;               0 - no errors

 +16      ;               1 - null Station ien input

 +17      ;               2 - null Location ien input

 +18      ;               3 - null HCPCS code input

 +19      ;               4 - null Item input

 +20      ;               5 - issued qty not greater than 0

 +21      ;               6 - problem with 661.7 file

FIFO(RMPR) ;

 +1        NEW RMPRERR,RMPRK,RMPROLD,RMPREOF,RMPR7,RMPR7I,RMPRIBAL,RMPRVBAL

 +2        NEW RMPRUVAL

 +3        SET RMPRERR=0

 +4        SET RMPRK("STATION")=$GET(RMPR("STATION IEN"))

 +5        IF RMPRK("STATION")=""

               SET RMPRERR=1

               GOTO FIFOX

 +6        SET RMPRK("LOCATION")=$GET(RMPR("LOCATION IEN"))

 +7        IF RMPRK("LOCATION")=""

               SET RMPRERR=2

               GOTO FIFOX

 +8        SET RMPRK("HCPCS")=$GET(RMPR("HCPCS"))

 +9        IF RMPRK("HCPCS")=""

               SET RMPRERR=3

               GOTO FIFOX

 +10       SET RMPRK("ITEM")=$GET(RMPR("ITEM"))

 +11       SET RMPRK("IEN")=$GET(RMPR("IEN"))

 +12       SET RMPRK("DATE&TIME")=$GET(RMPR("DATE&TIME"))

 +13       IF RMPRK("ITEM")=""

               SET RMPRERR=4

               GOTO FIFOX

 +14       IF '+$GET(RMPR("ISSUED QTY"))

               SET RMPRERR=5

               GOTO FIFOX

 +15      ; init issued qty. balance

           SET RMPRIBAL=RMPR("ISSUED QTY")

 +16      ; init issue value balance

           SET RMPRVBAL=+$GET(RMPR("ISSUED VALUE"))

 +17      ; unit cost per issued item

           SET RMPRUVAL=RMPRVBAL/RMPRIBAL

 +18       LOCK +^RMPR(661.7,"XSLHIDS",RMPR("STATION IEN"),RMPR("LOCATION IEN"),RMPR("HCPCS"),RMPR("ITEM"))

 +19       GOTO PASS

 +20      ;

 +21      ; Loop on all records for Stn, Loc, HCPCS and Item until stock

 +22      ; depleted by the issued amount

FIFOA      SET RMPRERR=$$NEXT^RMPRPIXE(.RMPRK,"XSLHIDS","",1,.RMPROLD,.RMPREOF)

 +1        IF RMPRERR

               SET RMPRERR=6

               GOTO FIFOU

 +2        IF RMPREOF

               GOTO FIFOU

 +3        IF RMPRK("ITEM")'=RMPROLD("ITEM")

               GOTO FIFOU

 +4        IF RMPRK("HCPCS")'=RMPROLD("HCPCS")

               GOTO FIFOU

 +5        IF RMPRK("LOCATION")'=RMPROLD("LOCATION")

               GOTO FIFOU

 +6        IF RMPRK("STATION")'=RMPROLD("STATION")

               GOTO FIFOU

PASS       KILL RMPR7

           MERGE RMPR7=RMPRK

 +1       ; read in current stock rec.

           SET RMPRERR=$$GET^RMPRPIX7(.RMPR7)

 +2        IF RMPRERR

               SET RMPRERR=6

               GOTO FIFOU

 +3        KILL RMPR7I

 +4        SET RMPR7I("IEN")=RMPR7("IEN")

 +5        SET RMPR7I("QUANTITY")=RMPR7("QUANTITY")

 +6        SET RMPR7I("VALUE")=RMPR7("VALUE")

 +7       ;

 +8       ; If issued balance less than on-hand quantity then update

 +9       ; the on-hand record

 +10       IF RMPRIBAL<RMPR7I("QUANTITY")

               Begin DoDot:1

 +11               SET RMPR7I("QUANTITY")=RMPR7I("QUANTITY")-RMPRIBAL

 +12               SET RMPR7I("VALUE")=RMPR7I("VALUE")-RMPRVBAL

 +13               SET RMPRERR=$$UPD^RMPRPIX7(.RMPR7I,)

 +14               SET RMPRIBAL=0

 +15               QUIT 

               End DoDot:1

 +16      ;

 +17      ; If issued balance not less than on-hand quantity the delete

 +18      ; the on-hand record

 +19      IF '$TEST

               Begin DoDot:1

 +20               SET RMPRIBAL=RMPRIBAL-RMPR7I("QUANTITY")

 +21               SET RMPRVBAL=RMPRVBAL-($JUSTIFY(RMPR7I("QUANTITY")*RMPRUVAL,0,2))

 +22               SET RMPRERR=$$DEL^RMPRPIX7(.RMPR7I)

 +23               QUIT 

               End DoDot:1

 +24       IF RMPRERR

               SET RMPRERR=6

               GOTO FIFOU

 +25      ; next stock rec. if still got issue balance

           if RMPRIBAL

               GOTO FIFOA

 +26      ;

 +27      ; exit points

FIFOU      LOCK -^RMPR(661.7,"XSLHIDS",RMPR("STATION IEN"),RMPR("LOCATION IEN"),RMPR("HCPCS"),RMPR("ITEM"))

FIFOX      QUIT RMPRERR