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
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRMPRPIU6 5461 printed Sep 23, 2025@20:12:26 Page 2
RMPRPIU6 ;HINCIO/ODJ - PIP STOCK ISSUE UPDATE UTILITY ;3/8/01
+1 ;;3.0;PROSTHETICS;**61**;Feb 09, 1996
+2 QUIT
+3 ;
+4 ;***** ISS - Create a Stock 'Issue to Patient' Transaction
+5 ; implements business rules for stock issue
+6 ;
+7 ; Inputs:
+8 ; RMPR60 - array of data fields for 660 file record...
+9 ; (all elements are required unless otherwise indicated)
+10 ; RMPR60("PATIENT IEN")- Prosthetic Patient
+11 ; (.01 field ptr to ^RMPR(665,)
+12 ; RMPR60("ISSUE TYPE") - Type of Issue (fld 2 - see FM set of codes)
+13 ; RMPR60("QUANTITY") - Number of items issued (fld 5)
+14 ; RMPR60("IFCAP ITEM") - IFCAP item (fld 4 ptr to ^RMPR(661,)
+15 ; RMPR60("VENDOR IEN") - Item Vendor (fld 7 ptr to ^PRC(440,)
+16 ; RMPR60("SERIAL NUM") - Serial Number (fld 9)
+17 ; (optional)
+18 ; RMPR60("REQ TYPE") - Request Type (fld 11 - see FM set of codes)
+19 ; (optional but will be set to 11 if not input)
+20 ; RMPR60("REMARKS") - Comments (fld 16)
+21 ; (optional)
+22 ; RMPR60("LOT NUM") - Lot number (fld 21)
+23 ; (optional)
+24 ; RMPR60("CPT MOD") - CPT modifier string (fld 4.7)
+25 ; (optional)
+26 ; RMPR60("COST") - Total value of issue (fld 14)
+27 ; RMPR60("CPT IEN") - field 21 ptr to ^ICPT
+28 ; RMPR60("SITE IEN") - ptr to prosthetic site param file 669.9
+29 ; RMPR60("USER") - User creating the issue
+30 ; (fld 27 ptr to ^VA(200,)
+31 ; RMPR60("PAT CAT") - Patient category
+32 ; (fld 62 see FM set of codes)
+33 ; RMPR60("SPEC CAT") - fld 63
+34 ; (optional)
+35 ; RMPR60("GROUPER") - AMIS grouper number
+36 ; RMPR60("DATE&TIME") - date and time item received
+37 ;
+38 ; RMPR11 - array of data fields for 661.11 record
+39 ; RMPR11("STATION") - Station ien
+40 ; RMPR11("HCPCS") - HCPCS code
+41 ; RMPR11("ITEM") - Item number
+42 ; RMPR11("UNIT") - Unit (optional)
+43 ; RMPR11("DESCRIPTION") - Item description
+44 ; RMPR11("SOURCE") - V - VA, C - Commercial
+45 ;
+46 ; RMPR5 - array of data fields for 661.5 record
+47 ; RMPR5("IEN") - Location ien (ptr to ^RMPR(661.5,)
+48 ;
+49 ; Outputs:
+50 ; RMPRERR - returned by function
+51 ; 0 - no problems
+52 ; 9 - insufficient stock to issue
+53 ; 10 - PIP item is locked
+54 ;
ISS(RMPR60,RMPR11,RMPR5) ;
+1 NEW RMPRERR,RMPR6,RMPR9,RMPR1,RMPRCSTK
+2 SET RMPRERR=0
+3 SET RMPR11("STATION IEN")=RMPR11("STATION")
+4 ;
+5 ; Lock Current Stock file (661.7) at Station, Location, HCPCS, Item
+6 ; level so that same item at same location cannot be depleted
+7 ; simultaneously.
+8 LOCK +^RMPR(661.7,"XSLHIDS",RMPR11("STATION IEN"),RMPR5("IEN"),RMPR11("HCPCS"),RMPR11("ITEM")):1
+9 IF $TEST=0
WRITE !,?5,$CHAR(7),"Someone else is Accessing the PIP item!",!
SET RMPRERR=10
GOTO ISSX
+10 ;
+11 ; Check stock level for entered Station, Location, HCPCS, Item
+12 ; and Vendor. Return error=9 if not enough stock.
+13 SET RMPRCSTK("STATION IEN")=RMPR11("STATION IEN")
+14 SET RMPRCSTK("LOCATION IEN")=RMPR5("IEN")
+15 SET RMPRCSTK("HCPCS")=RMPR11("HCPCS")
+16 SET RMPRCSTK("ITEM")=RMPR11("ITEM")
+17 SET RMPRCSTK("VENDOR IEN")=RMPR60("VENDOR IEN")
+18 SET RMPRERR=$$STOCK^RMPRPIUE(.RMPRCSTK)
+19 IF RMPRERR
SET RMPRERR=90
GOTO ISSU
+20 SET RMPRCSTK("IEN")=$ORDER(^RMPR(661.7,"XSLHIDS",RMPR11("STATION IEN"),RMPR5("IEN"),RMPR11("HCPCS"),RMPR11("ITEM"),RMPR60("DATE&TIME"),1,0))
+21 IF RMPR60("QUANTITY")>RMPRCSTK("QOH")
SET RMPRERR=9
SET RMPR60("QOH")=RMPRCSTK("QOH")
GOTO ISSU
+22 ;
+23 ; Create 661.6 - inventory transaction record - stock issue to patient
+24 SET RMPR6("COMMENT")=$GET(RMPR6("COMMENT"))
+25 SET RMPR6("SEQUENCE")=1
+26 SET RMPR6("TRAN TYPE")=3
+27 SET RMPR6("LOCATION")=RMPR5("IEN")
+28 SET RMPR6("USER")=RMPR60("USER")
+29 SET RMPR6("QUANTITY")=RMPR60("QUANTITY")
+30 SET RMPR6("VALUE")=RMPR60("COST")
+31 SET RMPR6("VENDOR")=RMPR60("VENDOR IEN")
+32 SET RMPRERR=$$CRE^RMPRPIX6(.RMPR6,.RMPR11)
+33 IF RMPRERR
SET RMPRERR=91
GOTO ISSU
+34 ;
+35 ; Create 660 record - patient 2319 - record of appliances, etc.
+36 SET RMPR60("COST")=$JUSTIFY(RMPR60("COST"),0,2)
+37 SET RMPR60("TRANS IEN")=RMPR6("IEN")
+38 SET RMPR60("ENTRY DATE")=$PIECE(RMPR6("DATE&TIME"),".",1)
+39 SET RMPR60("REQ DATE")=RMPR60("ENTRY DATE")
+40 SET RMPR60("DELIV DATE")=RMPR60("DELIV DATE")
+41 IF $GET(RMPR60("REQ TYPE"))=""
SET RMPR60("REQ TYPE")=11
+42 SET RMPRERR=$$CRE^RMPRPIX2(.RMPR60,.RMPR11)
+43 IF RMPRERR
SET RMPRERR=92
GOTO ISSU
+44 ;
+45 ; Create 661.63 record
+46 SET RMPRERR=$$CRE^RMPRPIX3(.RMPR60,.RMPR6,.RMPR11)
+47 IF RMPRERR
SET RMPRERR=93
GOTO ISSU
+48 ;
+49 ; Update 661.7 record
+50 SET RMPR7("STATION IEN")=RMPR11("STATION IEN")
+51 SET RMPR7("LOCATION IEN")=RMPR5("IEN")
+52 SET RMPR7("HCPCS")=RMPR11("HCPCS")
+53 SET RMPR7("ITEM")=RMPR11("ITEM")
+54 SET RMPR7("ISSUED QTY")=RMPR60("QUANTITY")
+55 SET RMPR7("ISSUED VALUE")=RMPR60("COST")
+56 SET RMPR7("DATE&TIME")=RMPR60("DATE&TIME")
+57 SET RMPR7("IEN")=RMPRCSTK("IEN")
+58 SET RMPRERR=$$FIFO^RMPRPIUB(.RMPR7)
+59 IF RMPRERR
SET RMPRERR=94
GOTO ISSU
+60 ;
+61 ; Update 661.9 record
+62 SET RMPR9("STA")=RMPR11("STATION IEN")
+63 SET RMPR9("HCP")=RMPR11("HCPCS")
+64 SET RMPR9("ITE")=RMPR11("ITEM")
+65 SET RMPR9("RDT")=$PIECE(RMPR6("DATE&TIME"),".",1)
+66 SET RMPR9("TQTY")=0-RMPR6("QUANTITY")
+67 SET RMPR9("TCST")=0-RMPR6("VALUE")
+68 SET RMPRERR=$$UPCR^RMPRPIXJ(.RMPR9)
+69 IF RMPRERR
SET RMPRERR=95
GOTO ISSU
+70 ;
+71 ;***** release lock on current stock and exit
ISSU LOCK -^RMPR(661.7,"XSLHIDS",RMPR11("STATION IEN"),RMPR5("IEN"),RMPR11("HCPCS"),RMPR11("ITEM"))
ISSX QUIT RMPRERR
