RMPRPIU9 ;HINCIO/ODJ - PIP STOCK RECONCILE UPDATE UTILITY;3/8/01
;;3.0;PROSTHETICS;**61**;Feb 09, 1996
Q
;
;***** REC - Create a Stock Reconciliation Transaction
;
; Inputs:
; RMPR6 -
; RMPR11 -
; RMPR5 -
;
; Outputs:
; RMPRERR -
;
REC(RMPR6,RMPR11,RMPR5) ;
N RMPRERR,RMPRCSTK,RMPRQGL,RMPRVGL,RMPRD,RMPRT,RMPR,RMPRUCST
S RMPRERR=0
;
; Lock the current stock 661.7 file at HCPCS Item level as we may be
; reducing or increasing the quantity on hand
L +^RMPR(661.7,"XSLHIDS",RMPR11("STATION IEN"),RMPR5("IEN"),RMPR11("HCPCS"),RMPR11("ITEM"))
;
; Get current quantity on hand
S RMPRCSTK("STATION IEN")=RMPR11("STATION IEN")
S RMPRCSTK("HCPCS")=RMPR11("HCPCS")
S RMPRCSTK("ITEM")=RMPR11("ITEM")
S RMPRCSTK("UNIT")=$G(RMPR11("UNIT"))
S RMPRCSTK("LOCATION IEN")=RMPR5("IEN")
S RMPRCSTK("VENDOR IEN")=RMPR6("VENDOR IEN")
S RMPRERR=$$STOCK^RMPRPIUE(.RMPRCSTK)
I RMPRERR S RMPRERR=11 G RECU ;error 11 - problem getting current qoh
S RMPRQGL=RMPR6("QUANTITY")-RMPRCSTK("QOH") ;gain/loss
S RMPRUCST=""
I $G(RMPR6("NEW UNIT COST"))'="" S RMPRUCST=RMPR6("NEW UNIT COST")
;
; If not showing any quantity on hand then use the unit cost
; of the most recent receipt or reconciliation transaction
I RMPRUCST="",RMPRCSTK("QOH")=0 D
. F RMPRT=3,9 D Q:RMPRERR!(RMPRD'="")
.. S RMPRD=$O(^RMPR(661.6,"ASTHIDS",RMPR11("STATION IEN"),RMPRT,RMPR11("HCPCS"),RMPR11("ITEM"),""),-1)
.. Q:RMPRD=""
.. K RMPR
.. S RMPR("IEN")=$QS($Q(^RMPR(661.6,"ASTHIDS",RMPR11("STATION IEN"),RMPRT,RMPR11("HCPCS"),RMPR11("ITEM"),RMPRD)),9)
.. S RMPRERR=$$GET^RMPRPIX6(.RMPR)
.. Q:RMPRERR
.. S:+RMPR("QUANTITY") RMPRUCST=RMPR("VALUE")/RMPR("QUANTITY")
.. Q
. Q
E D
. S:RMPRUCST="" RMPRUCST=RMPRCSTK("UNIT COST")
. Q
I RMPRUCST="" D
. S RMPRUCST=0
. I +RMPR6("QUANTITY"),+$G(RMPR6("VALUE")) D
.. S RMPRUCST=RMPR6("VALUE")/RMPR6("QUANTITY")
.. Q
. Q
I RMPRERR S RMPRERR=12 G RECU ;error 12 problem with cost
;
; calculate the gain/loss for value
S RMPRVGL=$J(RMPRQGL*RMPRUCST,0,2)
;
; Create a 661.6 Reconciliation Transaction record
S RMPR6("COMMENT")=$G(RMPR6("COMMENT"))
S RMPR6("SEQUENCE")=1
S RMPR6("TRAN TYPE")=9
S RMPR6("LOCATION")=RMPR5("IEN")
S RMPR6("USER")=$G(DUZ)
S RMPR6("VENDOR")=RMPR6("VENDOR IEN")
S RMPR6("VALUE")=$J(RMPR6("QUANTITY")*RMPRUCST,0,2)
K RMPR6("IEN")
S RMPR11("STATION")=RMPR11("STATION IEN")
S RMPRERR=$$CRE^RMPRPIX6(.RMPR6,.RMPR11)
I RMPRERR S RMPRERR=61 G RECU ;error 61 if problem with 661.6
;
; Create 661.69 Gain/Loss record
K RMPR
S RMPR("TRANS IEN")=RMPR6("IEN")
S RMPR("GAIN/LOSS")=RMPRQGL
S RMPR("GAIN/LOSS VALUE")=RMPRVGL
S RMPRERR=$$CRE^RMPRPIXB(.RMPR)
I RMPRERR S RMPRERR=61 G RECU ;error 61 if problem with 661.69
;
; Adjust stock for gain/loss
I RMPRQGL=0 G RECU ;no gain loss so just exit
I RMPRQGL>0 G RECGN ;adjust for stock gain
;
; Adjust for stock loss
RECLS K RMPR
S RMPR("STATION IEN")=RMPR11("STATION IEN")
S RMPR("LOCATION IEN")=RMPR5("IEN")
S RMPR("HCPCS")=RMPR11("HCPCS")
S RMPR("ITEM")=RMPR11("ITEM")
S RMPR("UNIT")=$G(RMPR11("UNIT"))
S RMPR("VENDOR IEN")=RMPR6("VENDOR IEN")
S RMPR("ISSUED QTY")=0-RMPRQGL
S RMPR("ISSUED VALUE")=0-RMPRVGL
S RMPRERR=$$FIFO^RMPRPIUF(.RMPR)
I RMPRERR S RMPRERR=71 G RECU ;error 71 problem with adjusting
K RMPR
S RMPR("STA")=RMPR11("STATION IEN")
S RMPR("HCP")=RMPR11("HCPCS")
S RMPR("ITE")=RMPR11("ITEM")
S RMPR("RDT")=$P(RMPR6("DATE&TIME"),".",1)
S RMPR("TQTY")=RMPRQGL
S RMPR("TCST")=RMPRVGL
S RMPRERR=$$UPCR^RMPRPIXJ(.RMPR)
I RMPRERR S RMPRERR=71
G RECU
;
; Adjust for stock gain
RECGN K RMPR
S RMPR("STATION")=RMPR11("STATION IEN")
S RMPR("LOCATION")=RMPR5("IEN")
S RMPR("HCPCS")=RMPR11("HCPCS")
S RMPR("ITEM")=RMPR11("ITEM")
S RMPR("UNIT")=$G(RMPR11("UNIT"))
S RMPR("VENDOR")=RMPR6("VENDOR IEN")
S RMPR("QUANTITY")=RMPRQGL
S RMPR("VALUE")=RMPRVGL
S RMPR("DATE&TIME")=$G(RMPR6("DATE&TIME"))
S RMPR("SEQUENCE")=RMPR6("SEQUENCE")
S RMPRERR=$$REVI^RMPRPIU1(.RMPR)
I RMPRERR S RMPRERR=71
G RECU
;
; 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[HRMPRPIU9 4234 printed Sep 23, 2025@20:12:29 Page 2
RMPRPIU9 ;HINCIO/ODJ - PIP STOCK RECONCILE UPDATE UTILITY;3/8/01
+1 ;;3.0;PROSTHETICS;**61**;Feb 09, 1996
+2 QUIT
+3 ;
+4 ;***** REC - Create a Stock Reconciliation Transaction
+5 ;
+6 ; Inputs:
+7 ; RMPR6 -
+8 ; RMPR11 -
+9 ; RMPR5 -
+10 ;
+11 ; Outputs:
+12 ; RMPRERR -
+13 ;
REC(RMPR6,RMPR11,RMPR5) ;
+1 NEW RMPRERR,RMPRCSTK,RMPRQGL,RMPRVGL,RMPRD,RMPRT,RMPR,RMPRUCST
+2 SET RMPRERR=0
+3 ;
+4 ; Lock the current stock 661.7 file at HCPCS Item level as we may be
+5 ; reducing or increasing the quantity on hand
+6 LOCK +^RMPR(661.7,"XSLHIDS",RMPR11("STATION IEN"),RMPR5("IEN"),RMPR11("HCPCS"),RMPR11("ITEM"))
+7 ;
+8 ; Get current quantity on hand
+9 SET RMPRCSTK("STATION IEN")=RMPR11("STATION IEN")
+10 SET RMPRCSTK("HCPCS")=RMPR11("HCPCS")
+11 SET RMPRCSTK("ITEM")=RMPR11("ITEM")
+12 SET RMPRCSTK("UNIT")=$GET(RMPR11("UNIT"))
+13 SET RMPRCSTK("LOCATION IEN")=RMPR5("IEN")
+14 SET RMPRCSTK("VENDOR IEN")=RMPR6("VENDOR IEN")
+15 SET RMPRERR=$$STOCK^RMPRPIUE(.RMPRCSTK)
+16 ;error 11 - problem getting current qoh
IF RMPRERR
SET RMPRERR=11
GOTO RECU
+17 ;gain/loss
SET RMPRQGL=RMPR6("QUANTITY")-RMPRCSTK("QOH")
+18 SET RMPRUCST=""
+19 IF $GET(RMPR6("NEW UNIT COST"))'=""
SET RMPRUCST=RMPR6("NEW UNIT COST")
+20 ;
+21 ; If not showing any quantity on hand then use the unit cost
+22 ; of the most recent receipt or reconciliation transaction
+23 IF RMPRUCST=""
IF RMPRCSTK("QOH")=0
Begin DoDot:1
+24 FOR RMPRT=3,9
Begin DoDot:2
+25 SET RMPRD=$ORDER(^RMPR(661.6,"ASTHIDS",RMPR11("STATION IEN"),RMPRT,RMPR11("HCPCS"),RMPR11("ITEM"),""),-1)
+26 if RMPRD=""
QUIT
+27 KILL RMPR
+28 SET RMPR("IEN")=$QSUBSCRIPT($QUERY(^RMPR(661.6,"ASTHIDS",RMPR11("STATION IEN"),RMPRT,RMPR11("HCPCS"),RMPR11("ITEM"),RMPRD)),9)
+29 SET RMPRERR=$$GET^RMPRPIX6(.RMPR)
+30 if RMPRERR
QUIT
+31 if +RMPR("QUANTITY")
SET RMPRUCST=RMPR("VALUE")/RMPR("QUANTITY")
+32 QUIT
End DoDot:2
if RMPRERR!(RMPRD'="")
QUIT
+33 QUIT
End DoDot:1
+34 IF '$TEST
Begin DoDot:1
+35 if RMPRUCST=""
SET RMPRUCST=RMPRCSTK("UNIT COST")
+36 QUIT
End DoDot:1
+37 IF RMPRUCST=""
Begin DoDot:1
+38 SET RMPRUCST=0
+39 IF +RMPR6("QUANTITY")
IF +$GET(RMPR6("VALUE"))
Begin DoDot:2
+40 SET RMPRUCST=RMPR6("VALUE")/RMPR6("QUANTITY")
+41 QUIT
End DoDot:2
+42 QUIT
End DoDot:1
+43 ;error 12 problem with cost
IF RMPRERR
SET RMPRERR=12
GOTO RECU
+44 ;
+45 ; calculate the gain/loss for value
+46 SET RMPRVGL=$JUSTIFY(RMPRQGL*RMPRUCST,0,2)
+47 ;
+48 ; Create a 661.6 Reconciliation Transaction record
+49 SET RMPR6("COMMENT")=$GET(RMPR6("COMMENT"))
+50 SET RMPR6("SEQUENCE")=1
+51 SET RMPR6("TRAN TYPE")=9
+52 SET RMPR6("LOCATION")=RMPR5("IEN")
+53 SET RMPR6("USER")=$GET(DUZ)
+54 SET RMPR6("VENDOR")=RMPR6("VENDOR IEN")
+55 SET RMPR6("VALUE")=$JUSTIFY(RMPR6("QUANTITY")*RMPRUCST,0,2)
+56 KILL RMPR6("IEN")
+57 SET RMPR11("STATION")=RMPR11("STATION IEN")
+58 SET RMPRERR=$$CRE^RMPRPIX6(.RMPR6,.RMPR11)
+59 ;error 61 if problem with 661.6
IF RMPRERR
SET RMPRERR=61
GOTO RECU
+60 ;
+61 ; Create 661.69 Gain/Loss record
+62 KILL RMPR
+63 SET RMPR("TRANS IEN")=RMPR6("IEN")
+64 SET RMPR("GAIN/LOSS")=RMPRQGL
+65 SET RMPR("GAIN/LOSS VALUE")=RMPRVGL
+66 SET RMPRERR=$$CRE^RMPRPIXB(.RMPR)
+67 ;error 61 if problem with 661.69
IF RMPRERR
SET RMPRERR=61
GOTO RECU
+68 ;
+69 ; Adjust stock for gain/loss
+70 ;no gain loss so just exit
IF RMPRQGL=0
GOTO RECU
+71 ;adjust for stock gain
IF RMPRQGL>0
GOTO RECGN
+72 ;
+73 ; Adjust for stock loss
RECLS KILL RMPR
+1 SET RMPR("STATION IEN")=RMPR11("STATION IEN")
+2 SET RMPR("LOCATION IEN")=RMPR5("IEN")
+3 SET RMPR("HCPCS")=RMPR11("HCPCS")
+4 SET RMPR("ITEM")=RMPR11("ITEM")
+5 SET RMPR("UNIT")=$GET(RMPR11("UNIT"))
+6 SET RMPR("VENDOR IEN")=RMPR6("VENDOR IEN")
+7 SET RMPR("ISSUED QTY")=0-RMPRQGL
+8 SET RMPR("ISSUED VALUE")=0-RMPRVGL
+9 SET RMPRERR=$$FIFO^RMPRPIUF(.RMPR)
+10 ;error 71 problem with adjusting
IF RMPRERR
SET RMPRERR=71
GOTO RECU
+11 KILL RMPR
+12 SET RMPR("STA")=RMPR11("STATION IEN")
+13 SET RMPR("HCP")=RMPR11("HCPCS")
+14 SET RMPR("ITE")=RMPR11("ITEM")
+15 SET RMPR("RDT")=$PIECE(RMPR6("DATE&TIME"),".",1)
+16 SET RMPR("TQTY")=RMPRQGL
+17 SET RMPR("TCST")=RMPRVGL
+18 SET RMPRERR=$$UPCR^RMPRPIXJ(.RMPR)
+19 IF RMPRERR
SET RMPRERR=71
+20 GOTO RECU
+21 ;
+22 ; Adjust for stock gain
RECGN KILL RMPR
+1 SET RMPR("STATION")=RMPR11("STATION IEN")
+2 SET RMPR("LOCATION")=RMPR5("IEN")
+3 SET RMPR("HCPCS")=RMPR11("HCPCS")
+4 SET RMPR("ITEM")=RMPR11("ITEM")
+5 SET RMPR("UNIT")=$GET(RMPR11("UNIT"))
+6 SET RMPR("VENDOR")=RMPR6("VENDOR IEN")
+7 SET RMPR("QUANTITY")=RMPRQGL
+8 SET RMPR("VALUE")=RMPRVGL
+9 SET RMPR("DATE&TIME")=$GET(RMPR6("DATE&TIME"))
+10 SET RMPR("SEQUENCE")=RMPR6("SEQUENCE")
+11 SET RMPRERR=$$REVI^RMPRPIU1(.RMPR)
+12 IF RMPRERR
SET RMPRERR=71
+13 GOTO RECU
+14 ;
+15 ; exit points
RECU LOCK -^RMPR(661.7,"XSLHIDS",RMPR11("STATION IEN"),RMPR5("IEN"),RMPR11("HCPCS"),RMPR11("ITEM"))
RECX QUIT RMPRERR
