source: FOIAVistA/trunk/r/PROSTHETICS-RMPR-RMPO-RMPS/RMPRPIU6.m@ 1397

Last change on this file since 1397 was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version
File size: 5.2 KB
Line 
1RMPRPIU6 ;HINCIO/ODJ - PIP STOCK ISSUE UPDATE UTILITY ;3/8/01
2 ;;3.0;PROSTHETICS;**61**;Feb 09, 1996
3 Q
4 ;
5 ;***** ISS - Create a Stock 'Issue to Patient' Transaction
6 ; implements business rules for stock issue
7 ;
8 ; Inputs:
9 ; RMPR60 - array of data fields for 660 file record...
10 ; (all elements are required unless otherwise indicated)
11 ; RMPR60("PATIENT IEN")- Prosthetic Patient
12 ; (.01 field ptr to ^RMPR(665,)
13 ; RMPR60("ISSUE TYPE") - Type of Issue (fld 2 - see FM set of codes)
14 ; RMPR60("QUANTITY") - Number of items issued (fld 5)
15 ; RMPR60("IFCAP ITEM") - IFCAP item (fld 4 ptr to ^RMPR(661,)
16 ; RMPR60("VENDOR IEN") - Item Vendor (fld 7 ptr to ^PRC(440,)
17 ; RMPR60("SERIAL NUM") - Serial Number (fld 9)
18 ; (optional)
19 ; RMPR60("REQ TYPE") - Request Type (fld 11 - see FM set of codes)
20 ; (optional but will be set to 11 if not input)
21 ; RMPR60("REMARKS") - Comments (fld 16)
22 ; (optional)
23 ; RMPR60("LOT NUM") - Lot number (fld 21)
24 ; (optional)
25 ; RMPR60("CPT MOD") - CPT modifier string (fld 4.7)
26 ; (optional)
27 ; RMPR60("COST") - Total value of issue (fld 14)
28 ; RMPR60("CPT IEN") - field 21 ptr to ^ICPT
29 ; RMPR60("SITE IEN") - ptr to prosthetic site param file 669.9
30 ; RMPR60("USER") - User creating the issue
31 ; (fld 27 ptr to ^VA(200,)
32 ; RMPR60("PAT CAT") - Patient category
33 ; (fld 62 see FM set of codes)
34 ; RMPR60("SPEC CAT") - fld 63
35 ; (optional)
36 ; RMPR60("GROUPER") - AMIS grouper number
37 ; RMPR60("DATE&TIME") - date and time item received
38 ;
39 ; RMPR11 - array of data fields for 661.11 record
40 ; RMPR11("STATION") - Station ien
41 ; RMPR11("HCPCS") - HCPCS code
42 ; RMPR11("ITEM") - Item number
43 ; RMPR11("UNIT") - Unit (optional)
44 ; RMPR11("DESCRIPTION") - Item description
45 ; RMPR11("SOURCE") - V - VA, C - Commercial
46 ;
47 ; RMPR5 - array of data fields for 661.5 record
48 ; RMPR5("IEN") - Location ien (ptr to ^RMPR(661.5,)
49 ;
50 ; Outputs:
51 ; RMPRERR - returned by function
52 ; 0 - no problems
53 ; 9 - insufficient stock to issue
54 ; 10 - PIP item is locked
55 ;
56ISS(RMPR60,RMPR11,RMPR5) ;
57 N RMPRERR,RMPR6,RMPR9,RMPR1,RMPRCSTK
58 S RMPRERR=0
59 S RMPR11("STATION IEN")=RMPR11("STATION")
60 ;
61 ; Lock Current Stock file (661.7) at Station, Location, HCPCS, Item
62 ; level so that same item at same location cannot be depleted
63 ; simultaneously.
64 L +^RMPR(661.7,"XSLHIDS",RMPR11("STATION IEN"),RMPR5("IEN"),RMPR11("HCPCS"),RMPR11("ITEM")):1
65 I $T=0 W !,?5,$C(7),"Someone else is Accessing the PIP item!",! S RMPRERR=10 G ISSX
66 ;
67 ; Check stock level for entered Station, Location, HCPCS, Item
68 ; and Vendor. Return error=9 if not enough stock.
69 S RMPRCSTK("STATION IEN")=RMPR11("STATION IEN")
70 S RMPRCSTK("LOCATION IEN")=RMPR5("IEN")
71 S RMPRCSTK("HCPCS")=RMPR11("HCPCS")
72 S RMPRCSTK("ITEM")=RMPR11("ITEM")
73 S RMPRCSTK("VENDOR IEN")=RMPR60("VENDOR IEN")
74 S RMPRERR=$$STOCK^RMPRPIUE(.RMPRCSTK)
75 I RMPRERR S RMPRERR=90 G ISSU
76 S RMPRCSTK("IEN")=$O(^RMPR(661.7,"XSLHIDS",RMPR11("STATION IEN"),RMPR5("IEN"),RMPR11("HCPCS"),RMPR11("ITEM"),RMPR60("DATE&TIME"),1,0))
77 I RMPR60("QUANTITY")>RMPRCSTK("QOH") S RMPRERR=9,RMPR60("QOH")=RMPRCSTK("QOH") G ISSU
78 ;
79 ; Create 661.6 - inventory transaction record - stock issue to patient
80 S RMPR6("COMMENT")=$G(RMPR6("COMMENT"))
81 S RMPR6("SEQUENCE")=1
82 S RMPR6("TRAN TYPE")=3
83 S RMPR6("LOCATION")=RMPR5("IEN")
84 S RMPR6("USER")=RMPR60("USER")
85 S RMPR6("QUANTITY")=RMPR60("QUANTITY")
86 S RMPR6("VALUE")=RMPR60("COST")
87 S RMPR6("VENDOR")=RMPR60("VENDOR IEN")
88 S RMPRERR=$$CRE^RMPRPIX6(.RMPR6,.RMPR11)
89 I RMPRERR S RMPRERR=91 G ISSU
90 ;
91 ; Create 660 record - patient 2319 - record of appliances, etc.
92 S RMPR60("COST")=$J(RMPR60("COST"),0,2)
93 S RMPR60("TRANS IEN")=RMPR6("IEN")
94 S RMPR60("ENTRY DATE")=$P(RMPR6("DATE&TIME"),".",1)
95 S RMPR60("REQ DATE")=RMPR60("ENTRY DATE")
96 S RMPR60("DELIV DATE")=RMPR60("DELIV DATE")
97 I $G(RMPR60("REQ TYPE"))="" S RMPR60("REQ TYPE")=11
98 S RMPRERR=$$CRE^RMPRPIX2(.RMPR60,.RMPR11)
99 I RMPRERR S RMPRERR=92 G ISSU
100 ;
101 ; Create 661.63 record
102 S RMPRERR=$$CRE^RMPRPIX3(.RMPR60,.RMPR6,.RMPR11)
103 I RMPRERR S RMPRERR=93 G ISSU
104 ;
105 ; Update 661.7 record
106 S RMPR7("STATION IEN")=RMPR11("STATION IEN")
107 S RMPR7("LOCATION IEN")=RMPR5("IEN")
108 S RMPR7("HCPCS")=RMPR11("HCPCS")
109 S RMPR7("ITEM")=RMPR11("ITEM")
110 S RMPR7("ISSUED QTY")=RMPR60("QUANTITY")
111 S RMPR7("ISSUED VALUE")=RMPR60("COST")
112 S RMPR7("DATE&TIME")=RMPR60("DATE&TIME")
113 S RMPR7("IEN")=RMPRCSTK("IEN")
114 S RMPRERR=$$FIFO^RMPRPIUB(.RMPR7)
115 I RMPRERR S RMPRERR=94 G ISSU
116 ;
117 ; Update 661.9 record
118 S RMPR9("STA")=RMPR11("STATION IEN")
119 S RMPR9("HCP")=RMPR11("HCPCS")
120 S RMPR9("ITE")=RMPR11("ITEM")
121 S RMPR9("RDT")=$P(RMPR6("DATE&TIME"),".",1)
122 S RMPR9("TQTY")=0-RMPR6("QUANTITY")
123 S RMPR9("TCST")=0-RMPR6("VALUE")
124 S RMPRERR=$$UPCR^RMPRPIXJ(.RMPR9)
125 I RMPRERR S RMPRERR=95 G ISSU
126 ;
127 ;***** release lock on current stock and exit
128ISSU L -^RMPR(661.7,"XSLHIDS",RMPR11("STATION IEN"),RMPR5("IEN"),RMPR11("HCPCS"),RMPR11("ITEM"))
129ISSX Q RMPRERR
Note: See TracBrowser for help on using the repository browser.