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 ---[H[J[2J[HRMPRPIU7 2607 printed Sep 23, 2025@20:12:27 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
