source: FOIAVistA/tag/r/PROSTHETICS-RMPR-RMPO-RMPS/RMPRPIU2.m@ 1607

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