Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: RMPRPIU2

RMPRPIU2.m

Go to the documentation of this file. 
  1. RMPRPIU2 ;HINCIO/ODJ - PIP STOCK ISSUE TO PATIENT UPDATE UILITY ;3/8/01
  1.  ;;3.0;PROSTHETICS;**61**;Feb 09, 1996
  1.  Q
  1.  ;
  1.  ; Continuation of RMPRPIU1
  1.  ;
  1.  ; if we get here then update is complex
  1.  ;
  1. MOD3 L +^RMPR(661.7,"XSLHIDS",RMPRC11("STATION IEN"),RMPRC5("IEN"),RMPRC11("HCPCS"),RMPRC11("ITEM"))
  1.  S RMPRERR=0
  1.  ;
  1.  ; Get current stock on hand and return error = 9 if not enough
  1.  S RMPRCSTK("STATION IEN")=RMPRC11("STATION IEN")
  1.  S RMPRCSTK("HCPCS")=RMPRC11("HCPCS")
  1.  S RMPRCSTK("ITEM")=RMPRC11("ITEM")
  1.  S RMPRCSTK("LOCATION IEN")=RMPRC5("IEN")
  1.  S RMPRCSTK("VENDOR IEN")=RMPRC60("VENDOR IEN")
  1.  S RMPRERR=$$STOCK^RMPRPIUE(.RMPRCSTK)
  1.  I RMPRERR S RMPRERR=21 G MODU
  1.  ;
  1.  ; if Location, HCPCS, Item or Vendor modified and the modified quantity
  1.  ; is more than the original then set error if insufficient current stock
  1.  I RMPRIREV D
  1.  . I RMPRQDIF'="",RMPR60("QUANTITY")>RMPRCSTK("QOH") D  Q
  1.  .. S RMPRERR=9,RMPR60("QOH")=RMPRCSTK("QOH")
  1.  .. Q
  1.  . I RMPRC60I("QUANTITY")>RMPRCSTK("QOH") D  Q
  1.  .. S RMPRERR=9,RMPR60("QOH")=RMPRCSTK("QOH")
  1.  . Q
  1.  ;
  1.  ; if just modifying quantity then check the difference
  1.  E  D
  1.  . I +RMPRQDIF>RMPRCSTK("QOH") S RMPRERR=9,RMPR60("QOH")=RMPRCSTK("QOH")
  1.  . Q
  1.  ;I RMPRERR G MODU
  1.  ;
  1.  ; If Location, HCPCS, Item or Vendor modified bring back the
  1.  ; stock for these values prior to modification and then reduce
  1.  ; stock for the modified values
  1.  I RMPRIREV D
  1.  . ;
  1.  . ; 1st bring back stock for original transaction
  1.  . S RMPRERR=$$REVI(.RMPRC6I)
  1.  . ;
  1.  . ; 2nd reduce stock for modified transaction
  1.  . ; 661.7 - current stock
  1.  . K RMPR
  1.  . S RMPR("STATION IEN")=RMPRC11("STATION IEN")
  1.  . S RMPR("LOCATION IEN")=RMPRC5("IEN")
  1.  . S RMPR("HCPCS")=RMPRC11("HCPCS")
  1.  . S RMPR("ITEM")=RMPRC11("ITEM")
  1.  . S RMPR("VENDOR IEN")=RMPRC60("VENDOR IEN")
  1.  . S RMPR("ISSUED QTY")=$S(RMPRQDIF'="":RMPR60("QUANTITY"),1:RMPRC60I("QUANTITY"))
  1.  . S RMPR("ISSUED VALUE")=$S(RMPRVDIF'="":RMPR60("COST"),1:RMPRC60I("COST"))
  1.  . S RMPRERR=$$FIFO^RMPRPIUF(.RMPR)
  1.  . ;
  1.  . ; 3rd update running balance 661.9
  1.  . K RMPR
  1.  . S RMPR("STA")=RMPRC11("STATION IEN")
  1.  . S RMPR("HCP")=RMPRC11("HCPCS")
  1.  . S RMPR("ITE")=RMPRC11("ITEM")
  1.  . S RMPR("RDT")=$P(RMPRC6I("DATE&TIME"),".",1)
  1.  . S RMPR("TQTY")=0-$S(RMPRQDIF'="":RMPR60("QUANTITY"),1:RMPRC60I("QUANTITY"))
  1.  . S RMPR("TCST")=0-$S(RMPRVDIF'="":RMPR60("COST"),1:RMPRC60I("COST"))
  1.  . S RMPRERR=$$UPCR^RMPRPIXJ(.RMPR)
  1.  . Q
  1.  ;
  1.  ; otherwise just adjust stock
  1.  E  D
  1.  . I RMPRQDIF<0 D  Q
  1.  .. S RMPRC6I("QUANTITY")=0-RMPRQDIF
  1.  .. S RMPRC6I("VALUE")=0-RMPRVDIF
  1.  .. S RMPRERR=$$REVI(.RMPRC6I)
  1.  .. Q
  1.  . I RMPRQDIF>0 D  Q
  1.  .. K RMPR
  1.  .. S RMPR("STATION IEN")=RMPRC11("STATION IEN")
  1.  .. S RMPR("LOCATION IEN")=RMPRC5("IEN")
  1.  .. S RMPR("HCPCS")=RMPRC11("HCPCS")
  1.  .. S RMPR("ITEM")=RMPRC11("ITEM")
  1.  .. S RMPR("VENDOR IEN")=RMPRC60("VENDOR IEN")
  1.  .. S RMPR("ISSUED QTY")=+RMPRQDIF
  1.  .. S RMPR("ISSUED VALUE")=+RMPRVDIF
  1.  .. S RMPRERR=$$FIFO^RMPRPIUF(.RMPR)
  1.  .. K RMPR
  1.  .. S RMPR("STA")=RMPRC11("STATION IEN")
  1.  .. S RMPR("HCP")=RMPRC11("HCPCS")
  1.  .. S RMPR("ITE")=RMPRC11("ITEM")
  1.  .. S RMPR("RDT")=$P(RMPRC6I("DATE&TIME"),".",1)
  1.  .. S RMPR("TQTY")=0-RMPRQDIF
  1.  .. S RMPR("TCST")=0-RMPRVDIF
  1.  .. S RMPRERR=$$UPCR^RMPRPIXJ(.RMPR)
  1.  .. Q
  1.  . Q
  1.  ;
  1.  ; Update 661.6
  1.  K RMPR
  1.  S RMPR("IEN")=RMPRC6I("IEN")
  1.  S:$D(RMPR60("QUANTITY")) RMPR("QUANTITY")=RMPR60("QUANTITY")
  1.  S:$D(RMPR60("COST")) RMPR("VALUE")=RMPR60("COST")
  1.  S RMPRERR=$$UPD^RMPRPIX6(.RMPR,.RMPR11)
  1.  I RMPRERR G MODU
  1.  ;
  1.  ; Update 660
  1.  S RMPRERR=$$UPD^RMPRPIX2(.RMPR60,.RMPR11)
  1.  ;
  1.  ; exit
  1. MODU L -^RMPR(661.7,"XSLHIDS",RMPRC11("STATION IEN"),RMPRC5("IEN"),RMPRC11("HCPCS"),RMPRC11("ITEM"))
  1. MODX Q RMPRERR
  1.  ;
  1.  ; REVI - bring back Issue transaction into stock
  1. REVI(RMPRC6I) ;
  1.  N RMPR,RMPROLD,RMPREOF,RMPRERR,RMPR7,RMPR7I,RMPRI,RMPR6,RMPR6I,RMPR9
  1.  S RMPRERR=0
  1.  S RMPR("STATION")=RMPRC6I("STATION")
  1.  S RMPR("HCPCS")=RMPRC6I("HCPCS")
  1.  S RMPR("ITEM")=RMPRC6I("ITEM")
  1.  S RMPR("LOCATION")=RMPRC6I("LOCATION")
  1.  L +^RMPR(661.7,"XSLHIDS",RMPRC6I("STATION"),RMPRC6I("LOCATION"),RMPRC6I("HCPCS"),RMPRC6I("ITEM"))
  1. REVIA S RMPRERR=$$NEXT^RMPRPIXE(.RMPR,"XSLHIDS","",1,.RMPROLD,.RMPREOF)
  1.  I RMPRERR S RMPRERR=11 G REVIX
  1.  I RMPREOF G REVIC
  1.  I RMPR("STATION")'=RMPRC6I("STATION") G REVIC
  1.  I RMPR("HCPCS")'=RMPRC6I("HCPCS") G REVIC
  1.  I RMPR("ITEM")'=RMPRC6I("ITEM") G REVIC
  1.  I RMPR("DATE&TIME")'=$G(RMPRC6I("DATE&TIME")) G REVIC
  1.  I RMPR("LOCATION")'=RMPRC6I("LOCATION") G REVIC
  1.  K RMPR7
  1.  S RMPR7("IEN")=RMPR("IEN")
  1.  S RMPRERR=$$GET^RMPRPIX7(.RMPR7)
  1.  I RMPRERR S RMPRERR=11 G REVIX
  1.  S RMPRERR=$$ETOI^RMPRPIX7(.RMPR7,.RMPR7I)
  1.  I RMPRERR S RMPRERR=11 G REVIX ;error 11 - problem with 661.7
  1.  I '$D(^RMPR(661.6,"XHDS",RMPR7I("HCPCS"),RMPR7I("DATE&TIME"),RMPR7I("SEQUENCE"))) G REVIA
  1.  S RMPRI=""
  1. REVIB S RMPRI=$O(^RMPR(661.6,"XHDS",RMPR7I("HCPCS"),RMPR7I("DATE&TIME"),RMPR7I("SEQUENCE"),RMPRI))
  1.  I RMPRI="" G REVIA
  1.  K RMPR6
  1.  S RMPR6("IEN")=RMPRI
  1.  S RMPRERR=$$GET^RMPRPIX6(.RMPR6)
  1.  I RMPRERR S RMPRERR=21 G REVIX
  1.  S RMPRERR=$$ETOI^RMPRPIX6(.RMPR6,.RMPR6I)
  1.  I RMPRERR S RMPRERR=21 G REVIX ;error 21 - problem with 661.6
  1.  I RMPR6I("VENDOR")'=RMPRC6I("VENDOR") G REVIB
  1.  ;
  1.  ; Update the current stock record
  1.  K RMPR
  1.  S RMPR("QUANTITY")=RMPR7I("QUANTITY")+RMPRC6I("QUANTITY")
  1.  S RMPR("VALUE")=RMPR7I("VALUE")+RMPRC6I("VALUE")
  1.  S RMPR("IEN")=RMPR7I("IEN")
  1.  S RMPRERR=$$UPD^RMPRPIX7(.RMPR,)
  1.  I RMPRERR S RMPRERR=31 G REVIX ;error 31 - problem with 661.7
  1.  G REVID ;now update 661.9 and exit
  1.  ;
  1.  ; If we get here there was no current stock record to update
  1.  ; so create one.
  1. REVIC K RMPR,RMPR7
  1.  S RMPR("STATION")=RMPRC6I("STATION")
  1.  S RMPR("HCPCS")=RMPRC6I("HCPCS")
  1.  S RMPR("ITEM")=RMPRC6I("ITEM")
  1.  S RMPR7("DATE&TIME")=$G(RMPRC6I("DATE&TIME"))
  1.  S RMPR7("SEQUENCE")=RMPRC6I("SEQUENCE")
  1.  S RMPR7("LOCATION")=RMPRC6I("LOCATION")
  1.  S RMPR7("QUANTITY")=RMPRC6I("QUANTITY")
  1.  S RMPR7("VALUE")=RMPRC6I("VALUE")
  1.  S RMPRERR=$$CRE^RMPRPIX7(.RMPR7,.RMPR)
  1.  I RMPRERR S RMPRERR=31 G REVIX
  1.  ;
  1.  ; Update 661.9 'running balance file' and exit
  1. REVID S RMPR9("STA")=RMPRC6I("STATION")
  1.  S RMPR9("HCP")=RMPRC6I("HCPCS")
  1.  S RMPR9("ITE")=RMPRC6I("ITEM")
  1.  S RMPR9("RDT")=$P(RMPRC6I("DATE&TIME"),".",1)
  1.  S RMPR9("TQTY")=RMPRC6I("QUANTITY")
  1.  S RMPR9("TCST")=RMPRC6I("VALUE")
  1.  S RMPRERR=$$UPCR^RMPRPIXJ(.RMPR9) ;error 41 - problem with 661.9
  1.  I RMPRERR S RMPRERR=41 G REVIX
  1. REVIX L -^RMPR(661.7,"XSLHIDS",RMPRC6I("STATION"),RMPRC6I("LOCATION"),RMPRC6I("HCPCS"),RMPRC6I("ITEM"))
  1.  Q RMPRERR