©2011-2018 Open Source Electronic Health Record Alliance
This work is licensed under a Creative Commons Attribution 3.0 Unported License
This work is licensed under a Creative Commons Attribution 3.0 Unported License
RMPRPIU6 ;HINCIO/ODJ - PIP STOCK ISSUE UPDATE UTILITY ;3/8/01
;;3.0;PROSTHETICS;**61**;Feb 09, 1996
Q
;
;***** ISS - Create a Stock 'Issue to Patient' Transaction
; implements business rules for stock issue
;
; Inputs:
; RMPR60 - array of data fields for 660 file record...
; (all elements are required unless otherwise indicated)
; RMPR60("PATIENT IEN")- Prosthetic Patient
; (.01 field ptr to ^RMPR(665,)
; RMPR60("ISSUE TYPE") - Type of Issue (fld 2 - see FM set of codes)
; RMPR60("QUANTITY") - Number of items issued (fld 5)
; RMPR60("IFCAP ITEM") - IFCAP item (fld 4 ptr to ^RMPR(661,)
; RMPR60("VENDOR IEN") - Item Vendor (fld 7 ptr to ^PRC(440,)
; RMPR60("SERIAL NUM") - Serial Number (fld 9)
; (optional)
; RMPR60("REQ TYPE") - Request Type (fld 11 - see FM set of codes)
; (optional but will be set to 11 if not input)
; RMPR60("REMARKS") - Comments (fld 16)
; (optional)
; RMPR60("LOT NUM") - Lot number (fld 21)
; (optional)
; RMPR60("CPT MOD") - CPT modifier string (fld 4.7)
; (optional)
; RMPR60("COST") - Total value of issue (fld 14)
; RMPR60("CPT IEN") - field 21 ptr to ^ICPT
; RMPR60("SITE IEN") - ptr to prosthetic site param file 669.9
; RMPR60("USER") - User creating the issue
; (fld 27 ptr to ^VA(200,)
; RMPR60("PAT CAT") - Patient category
; (fld 62 see FM set of codes)
; RMPR60("SPEC CAT") - fld 63
; (optional)
; RMPR60("GROUPER") - AMIS grouper number
; RMPR60("DATE&TIME") - date and time item received
;
; RMPR11 - array of data fields for 661.11 record
; RMPR11("STATION") - Station ien
; RMPR11("HCPCS") - HCPCS code
; RMPR11("ITEM") - Item number
; RMPR11("UNIT") - Unit (optional)
; RMPR11("DESCRIPTION") - Item description
; RMPR11("SOURCE") - V - VA, C - Commercial
;
; RMPR5 - array of data fields for 661.5 record
; RMPR5("IEN") - Location ien (ptr to ^RMPR(661.5,)
;
; Outputs:
; RMPRERR - returned by function
; 0 - no problems
; 9 - insufficient stock to issue
; 10 - PIP item is locked
;
ISS(RMPR60,RMPR11,RMPR5) ;
N RMPRERR,RMPR6,RMPR9,RMPR1,RMPRCSTK
S RMPRERR=0
S RMPR11("STATION IEN")=RMPR11("STATION")
;
; Lock Current Stock file (661.7) at Station, Location, HCPCS, Item
; level so that same item at same location cannot be depleted
; simultaneously.
L +^RMPR(661.7,"XSLHIDS",RMPR11("STATION IEN"),RMPR5("IEN"),RMPR11("HCPCS"),RMPR11("ITEM")):1
I $T=0 W !,?5,$C(7),"Someone else is Accessing the PIP item!",! S RMPRERR=10 G ISSX
;
; Check stock level for entered Station, Location, HCPCS, Item
; and Vendor. Return error=9 if not enough stock.
S RMPRCSTK("STATION IEN")=RMPR11("STATION IEN")
S RMPRCSTK("LOCATION IEN")=RMPR5("IEN")
S RMPRCSTK("HCPCS")=RMPR11("HCPCS")
S RMPRCSTK("ITEM")=RMPR11("ITEM")
S RMPRCSTK("VENDOR IEN")=RMPR60("VENDOR IEN")
S RMPRERR=$$STOCK^RMPRPIUE(.RMPRCSTK)
I RMPRERR S RMPRERR=90 G ISSU
S RMPRCSTK("IEN")=$O(^RMPR(661.7,"XSLHIDS",RMPR11("STATION IEN"),RMPR5("IEN"),RMPR11("HCPCS"),RMPR11("ITEM"),RMPR60("DATE&TIME"),1,0))
I RMPR60("QUANTITY")>RMPRCSTK("QOH") S RMPRERR=9,RMPR60("QOH")=RMPRCSTK("QOH") G ISSU
;
; Create 661.6 - inventory transaction record - stock issue to patient
S RMPR6("COMMENT")=$G(RMPR6("COMMENT"))
S RMPR6("SEQUENCE")=1
S RMPR6("TRAN TYPE")=3
S RMPR6("LOCATION")=RMPR5("IEN")
S RMPR6("USER")=RMPR60("USER")
S RMPR6("QUANTITY")=RMPR60("QUANTITY")
S RMPR6("VALUE")=RMPR60("COST")
S RMPR6("VENDOR")=RMPR60("VENDOR IEN")
S RMPRERR=$$CRE^RMPRPIX6(.RMPR6,.RMPR11)
I RMPRERR S RMPRERR=91 G ISSU
;
; Create 660 record - patient 2319 - record of appliances, etc.
S RMPR60("COST")=$J(RMPR60("COST"),0,2)
S RMPR60("TRANS IEN")=RMPR6("IEN")
S RMPR60("ENTRY DATE")=$P(RMPR6("DATE&TIME"),".",1)
S RMPR60("REQ DATE")=RMPR60("ENTRY DATE")
S RMPR60("DELIV DATE")=RMPR60("DELIV DATE")
I $G(RMPR60("REQ TYPE"))="" S RMPR60("REQ TYPE")=11
S RMPRERR=$$CRE^RMPRPIX2(.RMPR60,.RMPR11)
I RMPRERR S RMPRERR=92 G ISSU
;
; Create 661.63 record
S RMPRERR=$$CRE^RMPRPIX3(.RMPR60,.RMPR6,.RMPR11)
I RMPRERR S RMPRERR=93 G ISSU
;
; Update 661.7 record
S RMPR7("STATION IEN")=RMPR11("STATION IEN")
S RMPR7("LOCATION IEN")=RMPR5("IEN")
S RMPR7("HCPCS")=RMPR11("HCPCS")
S RMPR7("ITEM")=RMPR11("ITEM")
S RMPR7("ISSUED QTY")=RMPR60("QUANTITY")
S RMPR7("ISSUED VALUE")=RMPR60("COST")
S RMPR7("DATE&TIME")=RMPR60("DATE&TIME")
S RMPR7("IEN")=RMPRCSTK("IEN")
S RMPRERR=$$FIFO^RMPRPIUB(.RMPR7)
I RMPRERR S RMPRERR=94 G ISSU
;
; Update 661.9 record
S RMPR9("STA")=RMPR11("STATION IEN")
S RMPR9("HCP")=RMPR11("HCPCS")
S RMPR9("ITE")=RMPR11("ITEM")
S RMPR9("RDT")=$P(RMPR6("DATE&TIME"),".",1)
S RMPR9("TQTY")=0-RMPR6("QUANTITY")
S RMPR9("TCST")=0-RMPR6("VALUE")
S RMPRERR=$$UPCR^RMPRPIXJ(.RMPR9)
I RMPRERR S RMPRERR=95 G ISSU
;
;***** release lock on current stock and exit
ISSU L -^RMPR(661.7,"XSLHIDS",RMPR11("STATION IEN"),RMPR5("IEN"),RMPR11("HCPCS"),RMPR11("ITEM"))
ISSX Q RMPRERR