RMPRPIU7.m

RMPRPIU7 ;HINCIO/ODJ - PIP STOCK RECEIPT UPDATE UTILITY ;3/8/01

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

 Q

 ;

 ;***** REC - Create a Stock Receipt Transaction

 ;            implements business rules for Stock Receipt

 ;            called by RMPRPIY9

 ;

 ; Inputs:

 ;    RMPR6 - Transaction (661.6) array elements

 ;    RMPR6("VENDOR")   - Vendor ien

 ;    RMPR6("QUANTITY") - Receipt quantity

 ;    RMPR6("VALUE")    - Total $ value of received quantity

 ;    RMPR6("COMMENT")  - (optional) comment

 ;

 ;    RMPR11 - HCPCS Item (661.11) array elements

 ;    RMPR11("STATION IEN")

 ;    RMPR11("HCPCS")

 ;    RMPR11("ITEM")

 ;

 ;    RMPR5 - Location (661.5) array elements

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

 ;

 ;    RMPR4

 ;

 ; Outputs:

 ;    RMPR6("IEN")

 ;    RMPR4("IEN")

 ;    RMPRERR

 ;

REC(RMPR6,RMPR11,RMPR5) ;

 N RMPRERR,RMPR6I,RMPR7,RMPR9

 S RMPRERR=0

 S RMPR6("COMMENT")=$G(RMPR6("COMMENT"))

 S RMPR6("SEQUENCE")=1

 S RMPR6("TRAN TYPE")=1

 S RMPR6("LOCATION")=$G(RMPR5("IEN"))

 S RMPR6("HCPCS")=$G(RMPR11("HCPCS"))

 S RMPR6("ITEM")=$G(RMPR11("ITEM"))

 S RMPR6("USER")=$G(DUZ)

 I RMPR6("QUANTITY")=0 G RECX

 ;

 ; Lock current stock to prevent simultaneous access at HCPCS Item level

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

 ;

 ; Create 661.6 Transaction record

 S RMPRERR=$$CRE^RMPRPIX6(.RMPR6,.RMPR11)

 I RMPRERR S RMPRERR=19 G RECU ;error 19 problem with 661.6 create

 ;

 ; Create 661.7 Current Stock record

 S RMPR7("DATE&TIME")=RMPR6("DATE&TIME")

 S RMPR7("SEQUENCE")=RMPR6("SEQUENCE")

 S RMPR7("QUANTITY")=RMPR6("QUANTITY")

 S RMPR7("VALUE")=RMPR6("VALUE")

 S RMPR7("LOCATION")=RMPR6("LOCATION")

 S RMPRERR=$$CRE^RMPRPIX7(.RMPR7,.RMPR11)

 I RMPRERR S RMPRERR=29 G RECU ;error 29 problem with 661.7 create

 ;

 ; Update 661.9 Daily Running Balance record

 S RMPR9("STA")=RMPR11("STATION")

 S RMPR9("HCP")=RMPR11("HCPCS")

 S RMPR9("ITE")=RMPR11("ITEM")

 S RMPR9("RDT")=$P(RMPR6("DATE&TIME"),".",1)

 S RMPR9("TQTY")=RMPR6("QUANTITY")

 S RMPR9("TCST")=RMPR6("VALUE")

 S RMPRERR=$$UPCR^RMPRPIXJ(.RMPR9) ;error 49 problem with 661.9 update

 I RMPRERR S RMPRERR=49 G RECU ;error 49 problem with 661.9 update

 ;

 ; Update 661.41 orders record

 S RMPRERR=$$UPORD^RMPRPIU8(RMPR11("STATION IEN"),RMPR11("HCPCS"),RMPR11("ITEM"),RMPR6("QUANTITY"),RMPR6("VENDOR"))

 I RMPRERR S RMPRERR=59 G RECU ;error 59 problem with Orders update

 ;

 ; Exit points

RECU L -^RMPR(661.7,"XSLHIDS",RMPR11("STATION IEN"),RMPR5("IEN"),RMPR11("HCPCS"),RMPR11("ITEM"))

RECX Q RMPRERR

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---RMPRPIU7   2607     printed  Mar 13, 2025@21:41:11                                                                                                                                                                                                    Page 2

RMPRPIU7  ;HINCIO/ODJ - PIP STOCK RECEIPT UPDATE UTILITY ;3/8/01

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

 +2        QUIT 

 +3       ;

 +4       ;***** REC - Create a Stock Receipt Transaction

 +5       ;            implements business rules for Stock Receipt

 +6       ;            called by RMPRPIY9

 +7       ;

 +8       ; Inputs:

 +9       ;    RMPR6 - Transaction (661.6) array elements

 +10      ;    RMPR6("VENDOR")   - Vendor ien

 +11      ;    RMPR6("QUANTITY") - Receipt quantity

 +12      ;    RMPR6("VALUE")    - Total $ value of received quantity

 +13      ;    RMPR6("COMMENT")  - (optional) comment

 +14      ;

 +15      ;    RMPR11 - HCPCS Item (661.11) array elements

 +16      ;    RMPR11("STATION IEN")

 +17      ;    RMPR11("HCPCS")

 +18      ;    RMPR11("ITEM")

 +19      ;

 +20      ;    RMPR5 - Location (661.5) array elements

 +21      ;    RMPR5("IEN") - Location ien (ptr ^RMPR(661.5,)

 +22      ;

 +23      ;    RMPR4

 +24      ;

 +25      ; Outputs:

 +26      ;    RMPR6("IEN")

 +27      ;    RMPR4("IEN")

 +28      ;    RMPRERR

 +29      ;

REC(RMPR6,RMPR11,RMPR5) ;

 +1        NEW RMPRERR,RMPR6I,RMPR7,RMPR9

 +2        SET RMPRERR=0

 +3        SET RMPR6("COMMENT")=$GET(RMPR6("COMMENT"))

 +4        SET RMPR6("SEQUENCE")=1

 +5        SET RMPR6("TRAN TYPE")=1

 +6        SET RMPR6("LOCATION")=$GET(RMPR5("IEN"))

 +7        SET RMPR6("HCPCS")=$GET(RMPR11("HCPCS"))

 +8        SET RMPR6("ITEM")=$GET(RMPR11("ITEM"))

 +9        SET RMPR6("USER")=$GET(DUZ)

 +10       IF RMPR6("QUANTITY")=0

               GOTO RECX

 +11      ;

 +12      ; Lock current stock to prevent simultaneous access at HCPCS Item level

 +13       LOCK +^RMPR(661.7,"XSLHIDS",RMPR11("STATION IEN"),RMPR5("IEN"),RMPR11("HCPCS"),RMPR11("ITEM"))

 +14      ;

 +15      ; Create 661.6 Transaction record

 +16       SET RMPRERR=$$CRE^RMPRPIX6(.RMPR6,.RMPR11)

 +17      ;error 19 problem with 661.6 create

           IF RMPRERR

               SET RMPRERR=19

               GOTO RECU

 +18      ;

 +19      ; Create 661.7 Current Stock record

 +20       SET RMPR7("DATE&TIME")=RMPR6("DATE&TIME")

 +21       SET RMPR7("SEQUENCE")=RMPR6("SEQUENCE")

 +22       SET RMPR7("QUANTITY")=RMPR6("QUANTITY")

 +23       SET RMPR7("VALUE")=RMPR6("VALUE")

 +24       SET RMPR7("LOCATION")=RMPR6("LOCATION")

 +25       SET RMPRERR=$$CRE^RMPRPIX7(.RMPR7,.RMPR11)

 +26      ;error 29 problem with 661.7 create

           IF RMPRERR

               SET RMPRERR=29

               GOTO RECU

 +27      ;

 +28      ; Update 661.9 Daily Running Balance record

 +29       SET RMPR9("STA")=RMPR11("STATION")

 +30       SET RMPR9("HCP")=RMPR11("HCPCS")

 +31       SET RMPR9("ITE")=RMPR11("ITEM")

 +32       SET RMPR9("RDT")=$PIECE(RMPR6("DATE&TIME"),".",1)

 +33       SET RMPR9("TQTY")=RMPR6("QUANTITY")

 +34       SET RMPR9("TCST")=RMPR6("VALUE")

 +35      ;error 49 problem with 661.9 update

           SET RMPRERR=$$UPCR^RMPRPIXJ(.RMPR9)

 +36      ;error 49 problem with 661.9 update

           IF RMPRERR

               SET RMPRERR=49

               GOTO RECU

 +37      ;

 +38      ; Update 661.41 orders record

 +39       SET RMPRERR=$$UPORD^RMPRPIU8(RMPR11("STATION IEN"),RMPR11("HCPCS"),RMPR11("ITEM"),RMPR6("QUANTITY"),RMPR6("VENDOR"))

 +40      ;error 59 problem with Orders update

           IF RMPRERR

               SET RMPRERR=59

               GOTO RECU

 +41      ;

 +42      ; Exit points

RECU       LOCK -^RMPR(661.7,"XSLHIDS",RMPR11("STATION IEN"),RMPR5("IEN"),RMPR11("HCPCS"),RMPR11("ITEM"))

RECX       QUIT RMPRERR