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

RMPRPIU9.m

Go to the documentation of this file.
  1. RMPRPIU9 ;HINCIO/ODJ - PIP STOCK RECONCILE UPDATE UTILITY;3/8/01
  1. ;;3.0;PROSTHETICS;**61**;Feb 09, 1996
  1. Q
  1. ;
  1. ;***** REC - Create a Stock Reconciliation Transaction
  1. ;
  1. ; Inputs:
  1. ; RMPR6 -
  1. ; RMPR11 -
  1. ; RMPR5 -
  1. ;
  1. ; Outputs:
  1. ; RMPRERR -
  1. ;
  1. REC(RMPR6,RMPR11,RMPR5) ;
  1. N RMPRERR,RMPRCSTK,RMPRQGL,RMPRVGL,RMPRD,RMPRT,RMPR,RMPRUCST
  1. S RMPRERR=0
  1. ;
  1. ; Lock the current stock 661.7 file at HCPCS Item level as we may be
  1. ; reducing or increasing the quantity on hand
  1. L +^RMPR(661.7,"XSLHIDS",RMPR11("STATION IEN"),RMPR5("IEN"),RMPR11("HCPCS"),RMPR11("ITEM"))
  1. ;
  1. ; Get current quantity on hand
  1. S RMPRCSTK("STATION IEN")=RMPR11("STATION IEN")
  1. S RMPRCSTK("HCPCS")=RMPR11("HCPCS")
  1. S RMPRCSTK("ITEM")=RMPR11("ITEM")
  1. S RMPRCSTK("UNIT")=$G(RMPR11("UNIT"))
  1. S RMPRCSTK("LOCATION IEN")=RMPR5("IEN")
  1. S RMPRCSTK("VENDOR IEN")=RMPR6("VENDOR IEN")
  1. S RMPRERR=$$STOCK^RMPRPIUE(.RMPRCSTK)
  1. I RMPRERR S RMPRERR=11 G RECU ;error 11 - problem getting current qoh
  1. S RMPRQGL=RMPR6("QUANTITY")-RMPRCSTK("QOH") ;gain/loss
  1. S RMPRUCST=""
  1. I $G(RMPR6("NEW UNIT COST"))'="" S RMPRUCST=RMPR6("NEW UNIT COST")
  1. ;
  1. ; If not showing any quantity on hand then use the unit cost
  1. ; of the most recent receipt or reconciliation transaction
  1. I RMPRUCST="",RMPRCSTK("QOH")=0 D
  1. . F RMPRT=3,9 D Q:RMPRERR!(RMPRD'="")
  1. .. S RMPRD=$O(^RMPR(661.6,"ASTHIDS",RMPR11("STATION IEN"),RMPRT,RMPR11("HCPCS"),RMPR11("ITEM"),""),-1)
  1. .. Q:RMPRD=""
  1. .. K RMPR
  1. .. S RMPR("IEN")=$QS($Q(^RMPR(661.6,"ASTHIDS",RMPR11("STATION IEN"),RMPRT,RMPR11("HCPCS"),RMPR11("ITEM"),RMPRD)),9)
  1. .. S RMPRERR=$$GET^RMPRPIX6(.RMPR)
  1. .. Q:RMPRERR
  1. .. S:+RMPR("QUANTITY") RMPRUCST=RMPR("VALUE")/RMPR("QUANTITY")
  1. .. Q
  1. . Q
  1. E D
  1. . S:RMPRUCST="" RMPRUCST=RMPRCSTK("UNIT COST")
  1. . Q
  1. I RMPRUCST="" D
  1. . S RMPRUCST=0
  1. . I +RMPR6("QUANTITY"),+$G(RMPR6("VALUE")) D
  1. .. S RMPRUCST=RMPR6("VALUE")/RMPR6("QUANTITY")
  1. .. Q
  1. . Q
  1. I RMPRERR S RMPRERR=12 G RECU ;error 12 problem with cost
  1. ;
  1. ; calculate the gain/loss for value
  1. S RMPRVGL=$J(RMPRQGL*RMPRUCST,0,2)
  1. ;
  1. ; Create a 661.6 Reconciliation Transaction record
  1. S RMPR6("COMMENT")=$G(RMPR6("COMMENT"))
  1. S RMPR6("SEQUENCE")=1
  1. S RMPR6("TRAN TYPE")=9
  1. S RMPR6("LOCATION")=RMPR5("IEN")
  1. S RMPR6("USER")=$G(DUZ)
  1. S RMPR6("VENDOR")=RMPR6("VENDOR IEN")
  1. S RMPR6("VALUE")=$J(RMPR6("QUANTITY")*RMPRUCST,0,2)
  1. K RMPR6("IEN")
  1. S RMPR11("STATION")=RMPR11("STATION IEN")
  1. S RMPRERR=$$CRE^RMPRPIX6(.RMPR6,.RMPR11)
  1. I RMPRERR S RMPRERR=61 G RECU ;error 61 if problem with 661.6
  1. ;
  1. ; Create 661.69 Gain/Loss record
  1. K RMPR
  1. S RMPR("TRANS IEN")=RMPR6("IEN")
  1. S RMPR("GAIN/LOSS")=RMPRQGL
  1. S RMPR("GAIN/LOSS VALUE")=RMPRVGL
  1. S RMPRERR=$$CRE^RMPRPIXB(.RMPR)
  1. I RMPRERR S RMPRERR=61 G RECU ;error 61 if problem with 661.69
  1. ;
  1. ; Adjust stock for gain/loss
  1. I RMPRQGL=0 G RECU ;no gain loss so just exit
  1. I RMPRQGL>0 G RECGN ;adjust for stock gain
  1. ;
  1. ; Adjust for stock loss
  1. RECLS K RMPR
  1. S RMPR("STATION IEN")=RMPR11("STATION IEN")
  1. S RMPR("LOCATION IEN")=RMPR5("IEN")
  1. S RMPR("HCPCS")=RMPR11("HCPCS")
  1. S RMPR("ITEM")=RMPR11("ITEM")
  1. S RMPR("UNIT")=$G(RMPR11("UNIT"))
  1. S RMPR("VENDOR IEN")=RMPR6("VENDOR IEN")
  1. S RMPR("ISSUED QTY")=0-RMPRQGL
  1. S RMPR("ISSUED VALUE")=0-RMPRVGL
  1. S RMPRERR=$$FIFO^RMPRPIUF(.RMPR)
  1. I RMPRERR S RMPRERR=71 G RECU ;error 71 problem with adjusting
  1. K RMPR
  1. S RMPR("STA")=RMPR11("STATION IEN")
  1. S RMPR("HCP")=RMPR11("HCPCS")
  1. S RMPR("ITE")=RMPR11("ITEM")
  1. S RMPR("RDT")=$P(RMPR6("DATE&TIME"),".",1)
  1. S RMPR("TQTY")=RMPRQGL
  1. S RMPR("TCST")=RMPRVGL
  1. S RMPRERR=$$UPCR^RMPRPIXJ(.RMPR)
  1. I RMPRERR S RMPRERR=71
  1. G RECU
  1. ;
  1. ; Adjust for stock gain
  1. RECGN K RMPR
  1. S RMPR("STATION")=RMPR11("STATION IEN")
  1. S RMPR("LOCATION")=RMPR5("IEN")
  1. S RMPR("HCPCS")=RMPR11("HCPCS")
  1. S RMPR("ITEM")=RMPR11("ITEM")
  1. S RMPR("UNIT")=$G(RMPR11("UNIT"))
  1. S RMPR("VENDOR")=RMPR6("VENDOR IEN")
  1. S RMPR("QUANTITY")=RMPRQGL
  1. S RMPR("VALUE")=RMPRVGL
  1. S RMPR("DATE&TIME")=$G(RMPR6("DATE&TIME"))
  1. S RMPR("SEQUENCE")=RMPR6("SEQUENCE")
  1. S RMPRERR=$$REVI^RMPRPIU1(.RMPR)
  1. I RMPRERR S RMPRERR=71
  1. G RECU
  1. ;
  1. ; exit points
  1. RECU L -^RMPR(661.7,"XSLHIDS",RMPR11("STATION IEN"),RMPR5("IEN"),RMPR11("HCPCS"),RMPR11("ITEM"))
  1. RECX Q RMPRERR