RMPRPIU2 ;HINCIO/ODJ - PIP STOCK ISSUE TO PATIENT UPDATE UILITY ;3/8/01
;;3.0;PROSTHETICS;**61**;Feb 09, 1996
Q
;
; Continuation of RMPRPIU1
;
; if we get here then update is complex
;
MOD3 L +^RMPR(661.7,"XSLHIDS",RMPRC11("STATION IEN"),RMPRC5("IEN"),RMPRC11("HCPCS"),RMPRC11("ITEM"))
S RMPRERR=0
;
; Get current stock on hand and return error = 9 if not enough
S RMPRCSTK("STATION IEN")=RMPRC11("STATION IEN")
S RMPRCSTK("HCPCS")=RMPRC11("HCPCS")
S RMPRCSTK("ITEM")=RMPRC11("ITEM")
S RMPRCSTK("LOCATION IEN")=RMPRC5("IEN")
S RMPRCSTK("VENDOR IEN")=RMPRC60("VENDOR IEN")
S RMPRERR=$$STOCK^RMPRPIUE(.RMPRCSTK)
I RMPRERR S RMPRERR=21 G MODU
;
; if Location, HCPCS, Item or Vendor modified and the modified quantity
; is more than the original then set error if insufficient current stock
I RMPRIREV D
. I RMPRQDIF'="",RMPR60("QUANTITY")>RMPRCSTK("QOH") D Q
.. S RMPRERR=9,RMPR60("QOH")=RMPRCSTK("QOH")
.. Q
. I RMPRC60I("QUANTITY")>RMPRCSTK("QOH") D Q
.. S RMPRERR=9,RMPR60("QOH")=RMPRCSTK("QOH")
. Q
;
; if just modifying quantity then check the difference
E D
. I +RMPRQDIF>RMPRCSTK("QOH") S RMPRERR=9,RMPR60("QOH")=RMPRCSTK("QOH")
. Q
;I RMPRERR G MODU
;
; If Location, HCPCS, Item or Vendor modified bring back the
; stock for these values prior to modification and then reduce
; stock for the modified values
I RMPRIREV D
. ;
. ; 1st bring back stock for original transaction
. S RMPRERR=$$REVI(.RMPRC6I)
. ;
. ; 2nd reduce stock for modified transaction
. ; 661.7 - current stock
. K RMPR
. S RMPR("STATION IEN")=RMPRC11("STATION IEN")
. S RMPR("LOCATION IEN")=RMPRC5("IEN")
. S RMPR("HCPCS")=RMPRC11("HCPCS")
. S RMPR("ITEM")=RMPRC11("ITEM")
. S RMPR("VENDOR IEN")=RMPRC60("VENDOR IEN")
. S RMPR("ISSUED QTY")=$S(RMPRQDIF'="":RMPR60("QUANTITY"),1:RMPRC60I("QUANTITY"))
. S RMPR("ISSUED VALUE")=$S(RMPRVDIF'="":RMPR60("COST"),1:RMPRC60I("COST"))
. S RMPRERR=$$FIFO^RMPRPIUF(.RMPR)
. ;
. ; 3rd update running balance 661.9
. K RMPR
. S RMPR("STA")=RMPRC11("STATION IEN")
. S RMPR("HCP")=RMPRC11("HCPCS")
. S RMPR("ITE")=RMPRC11("ITEM")
. S RMPR("RDT")=$P(RMPRC6I("DATE&TIME"),".",1)
. S RMPR("TQTY")=0-$S(RMPRQDIF'="":RMPR60("QUANTITY"),1:RMPRC60I("QUANTITY"))
. S RMPR("TCST")=0-$S(RMPRVDIF'="":RMPR60("COST"),1:RMPRC60I("COST"))
. S RMPRERR=$$UPCR^RMPRPIXJ(.RMPR)
. Q
;
; otherwise just adjust stock
E D
. I RMPRQDIF<0 D Q
.. S RMPRC6I("QUANTITY")=0-RMPRQDIF
.. S RMPRC6I("VALUE")=0-RMPRVDIF
.. S RMPRERR=$$REVI(.RMPRC6I)
.. Q
. I RMPRQDIF>0 D Q
.. K RMPR
.. S RMPR("STATION IEN")=RMPRC11("STATION IEN")
.. S RMPR("LOCATION IEN")=RMPRC5("IEN")
.. S RMPR("HCPCS")=RMPRC11("HCPCS")
.. S RMPR("ITEM")=RMPRC11("ITEM")
.. S RMPR("VENDOR IEN")=RMPRC60("VENDOR IEN")
.. S RMPR("ISSUED QTY")=+RMPRQDIF
.. S RMPR("ISSUED VALUE")=+RMPRVDIF
.. S RMPRERR=$$FIFO^RMPRPIUF(.RMPR)
.. K RMPR
.. S RMPR("STA")=RMPRC11("STATION IEN")
.. S RMPR("HCP")=RMPRC11("HCPCS")
.. S RMPR("ITE")=RMPRC11("ITEM")
.. S RMPR("RDT")=$P(RMPRC6I("DATE&TIME"),".",1)
.. S RMPR("TQTY")=0-RMPRQDIF
.. S RMPR("TCST")=0-RMPRVDIF
.. S RMPRERR=$$UPCR^RMPRPIXJ(.RMPR)
.. Q
. Q
;
; Update 661.6
K RMPR
S RMPR("IEN")=RMPRC6I("IEN")
S:$D(RMPR60("QUANTITY")) RMPR("QUANTITY")=RMPR60("QUANTITY")
S:$D(RMPR60("COST")) RMPR("VALUE")=RMPR60("COST")
S RMPRERR=$$UPD^RMPRPIX6(.RMPR,.RMPR11)
I RMPRERR G MODU
;
; Update 660
S RMPRERR=$$UPD^RMPRPIX2(.RMPR60,.RMPR11)
;
; exit
MODU L -^RMPR(661.7,"XSLHIDS",RMPRC11("STATION IEN"),RMPRC5("IEN"),RMPRC11("HCPCS"),RMPRC11("ITEM"))
MODX Q RMPRERR
;
; REVI - bring back Issue transaction into stock
REVI(RMPRC6I) ;
N RMPR,RMPROLD,RMPREOF,RMPRERR,RMPR7,RMPR7I,RMPRI,RMPR6,RMPR6I,RMPR9
S RMPRERR=0
S RMPR("STATION")=RMPRC6I("STATION")
S RMPR("HCPCS")=RMPRC6I("HCPCS")
S RMPR("ITEM")=RMPRC6I("ITEM")
S RMPR("LOCATION")=RMPRC6I("LOCATION")
L +^RMPR(661.7,"XSLHIDS",RMPRC6I("STATION"),RMPRC6I("LOCATION"),RMPRC6I("HCPCS"),RMPRC6I("ITEM"))
REVIA S RMPRERR=$$NEXT^RMPRPIXE(.RMPR,"XSLHIDS","",1,.RMPROLD,.RMPREOF)
I RMPRERR S RMPRERR=11 G REVIX
I RMPREOF G REVIC
I RMPR("STATION")'=RMPRC6I("STATION") G REVIC
I RMPR("HCPCS")'=RMPRC6I("HCPCS") G REVIC
I RMPR("ITEM")'=RMPRC6I("ITEM") G REVIC
I RMPR("DATE&TIME")'=$G(RMPRC6I("DATE&TIME")) G REVIC
I RMPR("LOCATION")'=RMPRC6I("LOCATION") G REVIC
K RMPR7
S RMPR7("IEN")=RMPR("IEN")
S RMPRERR=$$GET^RMPRPIX7(.RMPR7)
I RMPRERR S RMPRERR=11 G REVIX
S RMPRERR=$$ETOI^RMPRPIX7(.RMPR7,.RMPR7I)
I RMPRERR S RMPRERR=11 G REVIX ;error 11 - problem with 661.7
I '$D(^RMPR(661.6,"XHDS",RMPR7I("HCPCS"),RMPR7I("DATE&TIME"),RMPR7I("SEQUENCE"))) G REVIA
S RMPRI=""
REVIB S RMPRI=$O(^RMPR(661.6,"XHDS",RMPR7I("HCPCS"),RMPR7I("DATE&TIME"),RMPR7I("SEQUENCE"),RMPRI))
I RMPRI="" G REVIA
K RMPR6
S RMPR6("IEN")=RMPRI
S RMPRERR=$$GET^RMPRPIX6(.RMPR6)
I RMPRERR S RMPRERR=21 G REVIX
S RMPRERR=$$ETOI^RMPRPIX6(.RMPR6,.RMPR6I)
I RMPRERR S RMPRERR=21 G REVIX ;error 21 - problem with 661.6
I RMPR6I("VENDOR")'=RMPRC6I("VENDOR") G REVIB
;
; Update the current stock record
K RMPR
S RMPR("QUANTITY")=RMPR7I("QUANTITY")+RMPRC6I("QUANTITY")
S RMPR("VALUE")=RMPR7I("VALUE")+RMPRC6I("VALUE")
S RMPR("IEN")=RMPR7I("IEN")
S RMPRERR=$$UPD^RMPRPIX7(.RMPR,)
I RMPRERR S RMPRERR=31 G REVIX ;error 31 - problem with 661.7
G REVID ;now update 661.9 and exit
;
; If we get here there was no current stock record to update
; so create one.
REVIC K RMPR,RMPR7
S RMPR("STATION")=RMPRC6I("STATION")
S RMPR("HCPCS")=RMPRC6I("HCPCS")
S RMPR("ITEM")=RMPRC6I("ITEM")
S RMPR7("DATE&TIME")=$G(RMPRC6I("DATE&TIME"))
S RMPR7("SEQUENCE")=RMPRC6I("SEQUENCE")
S RMPR7("LOCATION")=RMPRC6I("LOCATION")
S RMPR7("QUANTITY")=RMPRC6I("QUANTITY")
S RMPR7("VALUE")=RMPRC6I("VALUE")
S RMPRERR=$$CRE^RMPRPIX7(.RMPR7,.RMPR)
I RMPRERR S RMPRERR=31 G REVIX
;
; Update 661.9 'running balance file' and exit
REVID S RMPR9("STA")=RMPRC6I("STATION")
S RMPR9("HCP")=RMPRC6I("HCPCS")
S RMPR9("ITE")=RMPRC6I("ITEM")
S RMPR9("RDT")=$P(RMPRC6I("DATE&TIME"),".",1)
S RMPR9("TQTY")=RMPRC6I("QUANTITY")
S RMPR9("TCST")=RMPRC6I("VALUE")
S RMPRERR=$$UPCR^RMPRPIXJ(.RMPR9) ;error 41 - problem with 661.9
I RMPRERR S RMPRERR=41 G REVIX
REVIX L -^RMPR(661.7,"XSLHIDS",RMPRC6I("STATION"),RMPRC6I("LOCATION"),RMPRC6I("HCPCS"),RMPRC6I("ITEM"))
Q RMPRERR
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRMPRPIU2 6454 printed Apr 09, 2024@21:37:07 Page 2
RMPRPIU2 ;HINCIO/ODJ - PIP STOCK ISSUE TO PATIENT UPDATE UILITY ;3/8/01
+1 ;;3.0;PROSTHETICS;**61**;Feb 09, 1996
+2 QUIT
+3 ;
+4 ; Continuation of RMPRPIU1
+5 ;
+6 ; if we get here then update is complex
+7 ;
MOD3 LOCK +^RMPR(661.7,"XSLHIDS",RMPRC11("STATION IEN"),RMPRC5("IEN"),RMPRC11("HCPCS"),RMPRC11("ITEM"))
+1 SET RMPRERR=0
+2 ;
+3 ; Get current stock on hand and return error = 9 if not enough
+4 SET RMPRCSTK("STATION IEN")=RMPRC11("STATION IEN")
+5 SET RMPRCSTK("HCPCS")=RMPRC11("HCPCS")
+6 SET RMPRCSTK("ITEM")=RMPRC11("ITEM")
+7 SET RMPRCSTK("LOCATION IEN")=RMPRC5("IEN")
+8 SET RMPRCSTK("VENDOR IEN")=RMPRC60("VENDOR IEN")
+9 SET RMPRERR=$$STOCK^RMPRPIUE(.RMPRCSTK)
+10 IF RMPRERR
SET RMPRERR=21
GOTO MODU
+11 ;
+12 ; if Location, HCPCS, Item or Vendor modified and the modified quantity
+13 ; is more than the original then set error if insufficient current stock
+14 IF RMPRIREV
Begin DoDot:1
+15 IF RMPRQDIF'=""
IF RMPR60("QUANTITY")>RMPRCSTK("QOH")
Begin DoDot:2
+16 SET RMPRERR=9
SET RMPR60("QOH")=RMPRCSTK("QOH")
+17 QUIT
End DoDot:2
QUIT
+18 IF RMPRC60I("QUANTITY")>RMPRCSTK("QOH")
Begin DoDot:2
+19 SET RMPRERR=9
SET RMPR60("QOH")=RMPRCSTK("QOH")
End DoDot:2
QUIT
+20 QUIT
End DoDot:1
+21 ;
+22 ; if just modifying quantity then check the difference
+23 IF '$TEST
Begin DoDot:1
+24 IF +RMPRQDIF>RMPRCSTK("QOH")
SET RMPRERR=9
SET RMPR60("QOH")=RMPRCSTK("QOH")
+25 QUIT
End DoDot:1
+26 ;I RMPRERR G MODU
+27 ;
+28 ; If Location, HCPCS, Item or Vendor modified bring back the
+29 ; stock for these values prior to modification and then reduce
+30 ; stock for the modified values
+31 IF RMPRIREV
Begin DoDot:1
+32 ;
+33 ; 1st bring back stock for original transaction
+34 SET RMPRERR=$$REVI(.RMPRC6I)
+35 ;
+36 ; 2nd reduce stock for modified transaction
+37 ; 661.7 - current stock
+38 KILL RMPR
+39 SET RMPR("STATION IEN")=RMPRC11("STATION IEN")
+40 SET RMPR("LOCATION IEN")=RMPRC5("IEN")
+41 SET RMPR("HCPCS")=RMPRC11("HCPCS")
+42 SET RMPR("ITEM")=RMPRC11("ITEM")
+43 SET RMPR("VENDOR IEN")=RMPRC60("VENDOR IEN")
+44 SET RMPR("ISSUED QTY")=$SELECT(RMPRQDIF'="":RMPR60("QUANTITY"),1:RMPRC60I("QUANTITY"))
+45 SET RMPR("ISSUED VALUE")=$SELECT(RMPRVDIF'="":RMPR60("COST"),1:RMPRC60I("COST"))
+46 SET RMPRERR=$$FIFO^RMPRPIUF(.RMPR)
+47 ;
+48 ; 3rd update running balance 661.9
+49 KILL RMPR
+50 SET RMPR("STA")=RMPRC11("STATION IEN")
+51 SET RMPR("HCP")=RMPRC11("HCPCS")
+52 SET RMPR("ITE")=RMPRC11("ITEM")
+53 SET RMPR("RDT")=$PIECE(RMPRC6I("DATE&TIME"),".",1)
+54 SET RMPR("TQTY")=0-$SELECT(RMPRQDIF'="":RMPR60("QUANTITY"),1:RMPRC60I("QUANTITY"))
+55 SET RMPR("TCST")=0-$SELECT(RMPRVDIF'="":RMPR60("COST"),1:RMPRC60I("COST"))
+56 SET RMPRERR=$$UPCR^RMPRPIXJ(.RMPR)
+57 QUIT
End DoDot:1
+58 ;
+59 ; otherwise just adjust stock
+60 IF '$TEST
Begin DoDot:1
+61 IF RMPRQDIF<0
Begin DoDot:2
+62 SET RMPRC6I("QUANTITY")=0-RMPRQDIF
+63 SET RMPRC6I("VALUE")=0-RMPRVDIF
+64 SET RMPRERR=$$REVI(.RMPRC6I)
+65 QUIT
End DoDot:2
QUIT
+66 IF RMPRQDIF>0
Begin DoDot:2
+67 KILL RMPR
+68 SET RMPR("STATION IEN")=RMPRC11("STATION IEN")
+69 SET RMPR("LOCATION IEN")=RMPRC5("IEN")
+70 SET RMPR("HCPCS")=RMPRC11("HCPCS")
+71 SET RMPR("ITEM")=RMPRC11("ITEM")
+72 SET RMPR("VENDOR IEN")=RMPRC60("VENDOR IEN")
+73 SET RMPR("ISSUED QTY")=+RMPRQDIF
+74 SET RMPR("ISSUED VALUE")=+RMPRVDIF
+75 SET RMPRERR=$$FIFO^RMPRPIUF(.RMPR)
+76 KILL RMPR
+77 SET RMPR("STA")=RMPRC11("STATION IEN")
+78 SET RMPR("HCP")=RMPRC11("HCPCS")
+79 SET RMPR("ITE")=RMPRC11("ITEM")
+80 SET RMPR("RDT")=$PIECE(RMPRC6I("DATE&TIME"),".",1)
+81 SET RMPR("TQTY")=0-RMPRQDIF
+82 SET RMPR("TCST")=0-RMPRVDIF
+83 SET RMPRERR=$$UPCR^RMPRPIXJ(.RMPR)
+84 QUIT
End DoDot:2
QUIT
+85 QUIT
End DoDot:1
+86 ;
+87 ; Update 661.6
+88 KILL RMPR
+89 SET RMPR("IEN")=RMPRC6I("IEN")
+90 if $DATA(RMPR60("QUANTITY"))
SET RMPR("QUANTITY")=RMPR60("QUANTITY")
+91 if $DATA(RMPR60("COST"))
SET RMPR("VALUE")=RMPR60("COST")
+92 SET RMPRERR=$$UPD^RMPRPIX6(.RMPR,.RMPR11)
+93 IF RMPRERR
GOTO MODU
+94 ;
+95 ; Update 660
+96 SET RMPRERR=$$UPD^RMPRPIX2(.RMPR60,.RMPR11)
+97 ;
+98 ; exit
MODU LOCK -^RMPR(661.7,"XSLHIDS",RMPRC11("STATION IEN"),RMPRC5("IEN"),RMPRC11("HCPCS"),RMPRC11("ITEM"))
MODX QUIT RMPRERR
+1 ;
+2 ; REVI - bring back Issue transaction into stock
REVI(RMPRC6I) ;
+1 NEW RMPR,RMPROLD,RMPREOF,RMPRERR,RMPR7,RMPR7I,RMPRI,RMPR6,RMPR6I,RMPR9
+2 SET RMPRERR=0
+3 SET RMPR("STATION")=RMPRC6I("STATION")
+4 SET RMPR("HCPCS")=RMPRC6I("HCPCS")
+5 SET RMPR("ITEM")=RMPRC6I("ITEM")
+6 SET RMPR("LOCATION")=RMPRC6I("LOCATION")
+7 LOCK +^RMPR(661.7,"XSLHIDS",RMPRC6I("STATION"),RMPRC6I("LOCATION"),RMPRC6I("HCPCS"),RMPRC6I("ITEM"))
REVIA SET RMPRERR=$$NEXT^RMPRPIXE(.RMPR,"XSLHIDS","",1,.RMPROLD,.RMPREOF)
+1 IF RMPRERR
SET RMPRERR=11
GOTO REVIX
+2 IF RMPREOF
GOTO REVIC
+3 IF RMPR("STATION")'=RMPRC6I("STATION")
GOTO REVIC
+4 IF RMPR("HCPCS")'=RMPRC6I("HCPCS")
GOTO REVIC
+5 IF RMPR("ITEM")'=RMPRC6I("ITEM")
GOTO REVIC
+6 IF RMPR("DATE&TIME")'=$GET(RMPRC6I("DATE&TIME"))
GOTO REVIC
+7 IF RMPR("LOCATION")'=RMPRC6I("LOCATION")
GOTO REVIC
+8 KILL RMPR7
+9 SET RMPR7("IEN")=RMPR("IEN")
+10 SET RMPRERR=$$GET^RMPRPIX7(.RMPR7)
+11 IF RMPRERR
SET RMPRERR=11
GOTO REVIX
+12 SET RMPRERR=$$ETOI^RMPRPIX7(.RMPR7,.RMPR7I)
+13 ;error 11 - problem with 661.7
IF RMPRERR
SET RMPRERR=11
GOTO REVIX
+14 IF '$DATA(^RMPR(661.6,"XHDS",RMPR7I("HCPCS"),RMPR7I("DATE&TIME"),RMPR7I("SEQUENCE")))
GOTO REVIA
+15 SET RMPRI=""
REVIB SET RMPRI=$ORDER(^RMPR(661.6,"XHDS",RMPR7I("HCPCS"),RMPR7I("DATE&TIME"),RMPR7I("SEQUENCE"),RMPRI))
+1 IF RMPRI=""
GOTO REVIA
+2 KILL RMPR6
+3 SET RMPR6("IEN")=RMPRI
+4 SET RMPRERR=$$GET^RMPRPIX6(.RMPR6)
+5 IF RMPRERR
SET RMPRERR=21
GOTO REVIX
+6 SET RMPRERR=$$ETOI^RMPRPIX6(.RMPR6,.RMPR6I)
+7 ;error 21 - problem with 661.6
IF RMPRERR
SET RMPRERR=21
GOTO REVIX
+8 IF RMPR6I("VENDOR")'=RMPRC6I("VENDOR")
GOTO REVIB
+9 ;
+10 ; Update the current stock record
+11 KILL RMPR
+12 SET RMPR("QUANTITY")=RMPR7I("QUANTITY")+RMPRC6I("QUANTITY")
+13 SET RMPR("VALUE")=RMPR7I("VALUE")+RMPRC6I("VALUE")
+14 SET RMPR("IEN")=RMPR7I("IEN")
+15 SET RMPRERR=$$UPD^RMPRPIX7(.RMPR,)
+16 ;error 31 - problem with 661.7
IF RMPRERR
SET RMPRERR=31
GOTO REVIX
+17 ;now update 661.9 and exit
GOTO REVID
+18 ;
+19 ; If we get here there was no current stock record to update
+20 ; so create one.
REVIC KILL RMPR,RMPR7
+1 SET RMPR("STATION")=RMPRC6I("STATION")
+2 SET RMPR("HCPCS")=RMPRC6I("HCPCS")
+3 SET RMPR("ITEM")=RMPRC6I("ITEM")
+4 SET RMPR7("DATE&TIME")=$GET(RMPRC6I("DATE&TIME"))
+5 SET RMPR7("SEQUENCE")=RMPRC6I("SEQUENCE")
+6 SET RMPR7("LOCATION")=RMPRC6I("LOCATION")
+7 SET RMPR7("QUANTITY")=RMPRC6I("QUANTITY")
+8 SET RMPR7("VALUE")=RMPRC6I("VALUE")
+9 SET RMPRERR=$$CRE^RMPRPIX7(.RMPR7,.RMPR)
+10 IF RMPRERR
SET RMPRERR=31
GOTO REVIX
+11 ;
+12 ; Update 661.9 'running balance file' and exit
REVID SET RMPR9("STA")=RMPRC6I("STATION")
+1 SET RMPR9("HCP")=RMPRC6I("HCPCS")
+2 SET RMPR9("ITE")=RMPRC6I("ITEM")
+3 SET RMPR9("RDT")=$PIECE(RMPRC6I("DATE&TIME"),".",1)
+4 SET RMPR9("TQTY")=RMPRC6I("QUANTITY")
+5 SET RMPR9("TCST")=RMPRC6I("VALUE")
+6 ;error 41 - problem with 661.9
SET RMPRERR=$$UPCR^RMPRPIXJ(.RMPR9)
+7 IF RMPRERR
SET RMPRERR=41
GOTO REVIX
REVIX LOCK -^RMPR(661.7,"XSLHIDS",RMPRC6I("STATION"),RMPRC6I("LOCATION"),RMPRC6I("HCPCS"),RMPRC6I("ITEM"))
+1 QUIT RMPRERR
