- 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 Jan 18, 2025@03:37:28 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