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

RMPRPIUT.m

Go to the documentation of this file. 
  1. RMPRPIUT ;HINCIO/ODJ - STOCK TRANSFER TRANSACTION ;3/8/01
  1.  ;;3.0;PROSTHETICS;**61**;Feb 09, 1996
  1.  Q
  1.  ;
  1.  ;***** TRNF - create stock transfer transaction.
  1.  ;             implements business rules for transferring stock
  1.  ;             from one location to another.
  1.  ;
  1.  ; Inputs:
  1.  ;    RMPR   - array with following elements...
  1.  ;    RMPR("QUANTITY")
  1.  ;    RMPR("VENDOR IEN")
  1.  ;
  1.  ;    RMPR5F - array with 'From' Location data elements (661.5)...
  1.  ;    RMPR5F("IEN") - ien of 'From' Location
  1.  ;
  1.  ;    RMPR5T - array with 'To' Location data elements (661.5)...
  1.  ;    RMPR5T("IEN") - ien of 'To' Location
  1.  ;
  1.  ;    RMPR11 - array with HCPCS Item data elements (661.11)...
  1.  ;    RMPR11("STATION IEN") - Station number (ptr DIC(4,)
  1.  ;    RMPR11("HCPCS")       - HCPCS Code
  1.  ;    RMPR11("ITEM")        - HCPCS Item number
  1.  ;
  1.  ; Outputs:
  1.  ;    RMPRERR - error status returned by function
  1.  ;               0 - no problems
  1.  ;               1 - insufficient stock level at 'From' Location
  1.  ;              19 - problem getting current stock level
  1.  ;              29 - problem creating 'From' transfer
  1.  ;              39 - problem creating 'To' transfer
  1.  ;
  1. TRNF(RMPR,RMPR5F,RMPR5T,RMPR11) ;
  1.  N RMPRERR,RMPR6,RMPR7,RMPR7E,RMPR4,RMPRTCOS
  1.  S RMPRERR=0
  1.  S RMPR11("STATION")=RMPR11("STATION IEN")
  1.  S RMPR7("STATION IEN")=RMPR11("STATION IEN")
  1.  S RMPR7("LOCATION IEN")=RMPR5F("IEN")
  1.  S RMPR7("HCPCS")=RMPR11("HCPCS")
  1.  S RMPR7("ITEM")=RMPR11("ITEM")
  1.  S RMPR7("UNIT")=$G(RMPR5F("UNIT"))
  1.  S RMPR7("VENDOR IEN")=RMPR("VENDOR IEN")
  1.  ;
  1.  ; Lock file so that -ve stock not possible
  1.  L +^RMPR(661.7,"XSLHIDS",RMPR7("STATION IEN"),RMPR7("LOCATION IEN"),RMPR7("HCPCS"),RMPR7("ITEM"))
  1.  ;
  1.  ; Get item's total current stock for location and vendor
  1.  S RMPRERR=$$STOCK^RMPRPIUE(.RMPR7)
  1.  I RMPRERR S RMPRERR=19 G TRNFU ;error 19 problem getting cur. qty.
  1.  ;
  1.  ; If not enough available stock set error code 1 and exit
  1.  I RMPR("QUANTITY")>RMPR7("QOH") D  G TRNFU
  1.  . S RMPRERR=1
  1.  . S RMPR("QOH")=RMPR7("QOH")
  1.  . Q
  1.  ;
  1.  ; Continue the transaction
  1.  S RMPR("STATION")=RMPR11("STATION IEN")
  1.  S RMPR("LOCATION")=RMPR5F("IEN")
  1.  S RMPR("HCPCS")=RMPR11("HCPCS")
  1.  S RMPR("ITEM")=RMPR11("ITEM")
  1.  S RMPRERR=$$QCOST(.RMPR,RMPR("QUANTITY"),.RMPRTCOS)
  1.  S RMPR("VALUE")=RMPRTCOS
  1.  ;
  1.  ; Create transfer 'OUT' transaction (661.6)
  1.  K RMPR6
  1.  S RMPR6("SEQUENCE")=1
  1.  S RMPR6("TRAN TYPE")=7
  1.  S RMPR6("COMMENT")=$G(RMPR("COMMENT"))
  1.  S RMPR6("QUANTITY")=0-RMPR("QUANTITY")
  1.  S RMPR6("VALUE")=0-RMPR("VALUE")
  1.  S RMPR6("USER")=RMPR("USER")
  1.  S RMPR6("LOCATION")=RMPR5F("IEN")
  1.  S RMPR6("UNIT")=$G(RMPR5F("UNIT"))
  1.  S RMPR6("VENDOR")=RMPR7("VENDOR IEN")
  1.  S RMPRERR=$$CRE^RMPRPIX6(.RMPR6,.RMPR11)
  1.  I RMPRERR S RMPRERR=29 G TRNFU ;error 29 'From' transfer 661.6 problem
  1.  ;
  1.  ; Create transfer 'IN' transaction (661.6)
  1.  S RMPR6("QUANTITY")=RMPR("QUANTITY")
  1.  S RMPR6("VALUE")=RMPR("VALUE")
  1.  S RMPR6("LOCATION")=RMPR5T("IEN")
  1.  S RMPR6("UNIT")=$G(RMPR5T("UNIT"))
  1.  S RMPRERR=$$CRE^RMPRPIX6(.RMPR6,.RMPR11)
  1.  I RMPRERR S RMPRERR=39 G TRNFU ;error 39 'To' transfer 661.6 problem
  1.  ;
  1.  ; See if need to create a PIP record in 661.4
  1.  I '$D(^RMPR(661.4,"ASLHI",RMPR11("STATION IEN"),RMPR5T("IEN"),RMPR11("HCPCS"),RMPR11("ITEM"))) D
  1.  . K RMPR4
  1.  . S RMPR4("RE-ORDER QTY")=0
  1.  . S RMPRERR=$$CRE^RMPRPIX4(.RMPR4,.RMPR11,.RMPR5T)
  1.  . Q
  1.  I RMPRERR S RMPRERR=39 G TRNFU
  1.  ;
  1.  ; Update current stock
  1.  K RMPR7E
  1.  S RMPR7E("TRNF QTY")=RMPR("QUANTITY")
  1.  S RMPR7E("TRNF VALUE")=RMPR("VALUE")
  1.  S RMPR7E("VENDOR IEN")=RMPR("VENDOR IEN")
  1.  S RMPR7E("UNIT")=$G(RMPR("UNIT"))
  1.  S RMPRERR=$$TRNF^RMPRPIUC(.RMPR11,.RMPR5F,.RMPR5T,.RMPR7E)
  1.  I RMPRERR S RMPRERR=49 G TRNFU ;error 49 current stock update problem
  1.  ;
  1.  ; exit points
  1. TRNFU L -^RMPR(661.7,"XSLHIDS",RMPR7("STATION IEN"),RMPR7("LOCATION IEN"),RMPR7("HCPCS"),RMPR7("ITEM"))
  1. TRNFX Q RMPRERR
  1.  ;
  1.  ; Work out total cost of quantity based on FIFO principles
  1. QCOST(RMPRK,RMPRQTY,RMPRTCOS) ;
  1.  N RMPRERR,RMPR,RMPR6,RMPR7,RMPRVNDR,RMPRQ,RMPRUVAL,RMPROLD,RMPREOF
  1.  S RMPRERR=0
  1.  S RMPRTCOS=0
  1.  S RMPRQ=RMPRQTY
  1.  M RMPR=RMPRK
  1.  S RMPRVNDR=RMPRK("VENDOR IEN")
  1. QCOST1 S RMPRERR=$$NEXT^RMPRPIXE(.RMPR,"XSLHIDS","",1,.RMPROLD,.RMPREOF)
  1.  I RMPRERR S RMPRERR=1 G QCOSTX
  1.  I RMPREOF G QCOSTX
  1.  I RMPR("STATION")'=RMPRK("STATION") G QCOSTX
  1.  I RMPR("LOCATION")'=RMPRK("LOCATION") G QCOSTX
  1.  I RMPR("HCPCS")'=RMPRK("HCPCS") G QCOSTX
  1.  I RMPR("ITEM")'=RMPRK("ITEM") G QCOSTX
  1.  K RMPR7 M RMPR7=RMPR
  1.  S RMPRERR=$$GET^RMPRPIX7(.RMPR7)
  1.  I RMPRERR S RMPRERR=1 G QCOSTX
  1.  K RMPR6 M RMPR6=RMPR S RMPR6("IEN")=""
  1.  S RMPRERR=$$GET^RMPRPIX6(.RMPR6)
  1.  S RMPRERR=$$VNDIEN^RMPRPIX6(.RMPR6)
  1.  I RMPRERR S RMPRERR=1 G QCOSTX
  1.  I RMPR6("VENDOR IEN")'=RMPRVNDR G QCOST1
  1.  S RMPRUVAL=$J(RMPR7("VALUE")/RMPR7("QUANTITY"),"",2)
  1.  S RMPRTCOS=RMPRTCOS+(RMPRQ*RMPRUVAL)
  1.  I RMPR7("QUANTITY")<RMPRQ S RMPRQ=RMPRQ-RMPR7("QUANTITY") G QCOST1
  1. QCOSTX Q RMPRERR