source: WorldVistAEHR/trunk/r/PROSTHETICS-RMPR-RMPO-RMPS/RMPRPIU2.m@ 1006

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

initial load of WorldVistAEHR

File size: 6.1 KB
RevLine 
[613]1RMPRPIU2 ;HINCIO/ODJ - PIP STOCK ISSUE TO PATIENT UPDATE UILITY ;3/8/01
2 ;;3.0;PROSTHETICS;**61**;Feb 09, 1996
3 Q
4 ;
5 ; Continuation of RMPRPIU1
6 ;
7 ; if we get here then update is complex
8 ;
9MOD3 L +^RMPR(661.7,"XSLHIDS",RMPRC11("STATION IEN"),RMPRC5("IEN"),RMPRC11("HCPCS"),RMPRC11("ITEM"))
10 S RMPRERR=0
11 ;
12 ; Get current stock on hand and return error = 9 if not enough
13 S RMPRCSTK("STATION IEN")=RMPRC11("STATION IEN")
14 S RMPRCSTK("HCPCS")=RMPRC11("HCPCS")
15 S RMPRCSTK("ITEM")=RMPRC11("ITEM")
16 S RMPRCSTK("LOCATION IEN")=RMPRC5("IEN")
17 S RMPRCSTK("VENDOR IEN")=RMPRC60("VENDOR IEN")
18 S RMPRERR=$$STOCK^RMPRPIUE(.RMPRCSTK)
19 I RMPRERR S RMPRERR=21 G MODU
20 ;
21 ; if Location, HCPCS, Item or Vendor modified and the modified quantity
22 ; is more than the original then set error if insufficient current stock
23 I RMPRIREV D
24 . I RMPRQDIF'="",RMPR60("QUANTITY")>RMPRCSTK("QOH") D Q
25 .. S RMPRERR=9,RMPR60("QOH")=RMPRCSTK("QOH")
26 .. Q
27 . I RMPRC60I("QUANTITY")>RMPRCSTK("QOH") D Q
28 .. S RMPRERR=9,RMPR60("QOH")=RMPRCSTK("QOH")
29 . Q
30 ;
31 ; if just modifying quantity then check the difference
32 E D
33 . I +RMPRQDIF>RMPRCSTK("QOH") S RMPRERR=9,RMPR60("QOH")=RMPRCSTK("QOH")
34 . Q
35 ;I RMPRERR G MODU
36 ;
37 ; If Location, HCPCS, Item or Vendor modified bring back the
38 ; stock for these values prior to modification and then reduce
39 ; stock for the modified values
40 I RMPRIREV D
41 . ;
42 . ; 1st bring back stock for original transaction
43 . S RMPRERR=$$REVI(.RMPRC6I)
44 . ;
45 . ; 2nd reduce stock for modified transaction
46 . ; 661.7 - current stock
47 . K RMPR
48 . S RMPR("STATION IEN")=RMPRC11("STATION IEN")
49 . S RMPR("LOCATION IEN")=RMPRC5("IEN")
50 . S RMPR("HCPCS")=RMPRC11("HCPCS")
51 . S RMPR("ITEM")=RMPRC11("ITEM")
52 . S RMPR("VENDOR IEN")=RMPRC60("VENDOR IEN")
53 . S RMPR("ISSUED QTY")=$S(RMPRQDIF'="":RMPR60("QUANTITY"),1:RMPRC60I("QUANTITY"))
54 . S RMPR("ISSUED VALUE")=$S(RMPRVDIF'="":RMPR60("COST"),1:RMPRC60I("COST"))
55 . S RMPRERR=$$FIFO^RMPRPIUF(.RMPR)
56 . ;
57 . ; 3rd update running balance 661.9
58 . K RMPR
59 . S RMPR("STA")=RMPRC11("STATION IEN")
60 . S RMPR("HCP")=RMPRC11("HCPCS")
61 . S RMPR("ITE")=RMPRC11("ITEM")
62 . S RMPR("RDT")=$P(RMPRC6I("DATE&TIME"),".",1)
63 . S RMPR("TQTY")=0-$S(RMPRQDIF'="":RMPR60("QUANTITY"),1:RMPRC60I("QUANTITY"))
64 . S RMPR("TCST")=0-$S(RMPRVDIF'="":RMPR60("COST"),1:RMPRC60I("COST"))
65 . S RMPRERR=$$UPCR^RMPRPIXJ(.RMPR)
66 . Q
67 ;
68 ; otherwise just adjust stock
69 E D
70 . I RMPRQDIF<0 D Q
71 .. S RMPRC6I("QUANTITY")=0-RMPRQDIF
72 .. S RMPRC6I("VALUE")=0-RMPRVDIF
73 .. S RMPRERR=$$REVI(.RMPRC6I)
74 .. Q
75 . I RMPRQDIF>0 D Q
76 .. K RMPR
77 .. S RMPR("STATION IEN")=RMPRC11("STATION IEN")
78 .. S RMPR("LOCATION IEN")=RMPRC5("IEN")
79 .. S RMPR("HCPCS")=RMPRC11("HCPCS")
80 .. S RMPR("ITEM")=RMPRC11("ITEM")
81 .. S RMPR("VENDOR IEN")=RMPRC60("VENDOR IEN")
82 .. S RMPR("ISSUED QTY")=+RMPRQDIF
83 .. S RMPR("ISSUED VALUE")=+RMPRVDIF
84 .. S RMPRERR=$$FIFO^RMPRPIUF(.RMPR)
85 .. K RMPR
86 .. S RMPR("STA")=RMPRC11("STATION IEN")
87 .. S RMPR("HCP")=RMPRC11("HCPCS")
88 .. S RMPR("ITE")=RMPRC11("ITEM")
89 .. S RMPR("RDT")=$P(RMPRC6I("DATE&TIME"),".",1)
90 .. S RMPR("TQTY")=0-RMPRQDIF
91 .. S RMPR("TCST")=0-RMPRVDIF
92 .. S RMPRERR=$$UPCR^RMPRPIXJ(.RMPR)
93 .. Q
94 . Q
95 ;
96 ; Update 661.6
97 K RMPR
98 S RMPR("IEN")=RMPRC6I("IEN")
99 S:$D(RMPR60("QUANTITY")) RMPR("QUANTITY")=RMPR60("QUANTITY")
100 S:$D(RMPR60("COST")) RMPR("VALUE")=RMPR60("COST")
101 S RMPRERR=$$UPD^RMPRPIX6(.RMPR,.RMPR11)
102 I RMPRERR G MODU
103 ;
104 ; Update 660
105 S RMPRERR=$$UPD^RMPRPIX2(.RMPR60,.RMPR11)
106 ;
107 ; exit
108MODU L -^RMPR(661.7,"XSLHIDS",RMPRC11("STATION IEN"),RMPRC5("IEN"),RMPRC11("HCPCS"),RMPRC11("ITEM"))
109MODX Q RMPRERR
110 ;
111 ; REVI - bring back Issue transaction into stock
112REVI(RMPRC6I) ;
113 N RMPR,RMPROLD,RMPREOF,RMPRERR,RMPR7,RMPR7I,RMPRI,RMPR6,RMPR6I,RMPR9
114 S RMPRERR=0
115 S RMPR("STATION")=RMPRC6I("STATION")
116 S RMPR("HCPCS")=RMPRC6I("HCPCS")
117 S RMPR("ITEM")=RMPRC6I("ITEM")
118 S RMPR("LOCATION")=RMPRC6I("LOCATION")
119 L +^RMPR(661.7,"XSLHIDS",RMPRC6I("STATION"),RMPRC6I("LOCATION"),RMPRC6I("HCPCS"),RMPRC6I("ITEM"))
120REVIA S RMPRERR=$$NEXT^RMPRPIXE(.RMPR,"XSLHIDS","",1,.RMPROLD,.RMPREOF)
121 I RMPRERR S RMPRERR=11 G REVIX
122 I RMPREOF G REVIC
123 I RMPR("STATION")'=RMPRC6I("STATION") G REVIC
124 I RMPR("HCPCS")'=RMPRC6I("HCPCS") G REVIC
125 I RMPR("ITEM")'=RMPRC6I("ITEM") G REVIC
126 I RMPR("DATE&TIME")'=$G(RMPRC6I("DATE&TIME")) G REVIC
127 I RMPR("LOCATION")'=RMPRC6I("LOCATION") G REVIC
128 K RMPR7
129 S RMPR7("IEN")=RMPR("IEN")
130 S RMPRERR=$$GET^RMPRPIX7(.RMPR7)
131 I RMPRERR S RMPRERR=11 G REVIX
132 S RMPRERR=$$ETOI^RMPRPIX7(.RMPR7,.RMPR7I)
133 I RMPRERR S RMPRERR=11 G REVIX ;error 11 - problem with 661.7
134 I '$D(^RMPR(661.6,"XHDS",RMPR7I("HCPCS"),RMPR7I("DATE&TIME"),RMPR7I("SEQUENCE"))) G REVIA
135 S RMPRI=""
136REVIB S RMPRI=$O(^RMPR(661.6,"XHDS",RMPR7I("HCPCS"),RMPR7I("DATE&TIME"),RMPR7I("SEQUENCE"),RMPRI))
137 I RMPRI="" G REVIA
138 K RMPR6
139 S RMPR6("IEN")=RMPRI
140 S RMPRERR=$$GET^RMPRPIX6(.RMPR6)
141 I RMPRERR S RMPRERR=21 G REVIX
142 S RMPRERR=$$ETOI^RMPRPIX6(.RMPR6,.RMPR6I)
143 I RMPRERR S RMPRERR=21 G REVIX ;error 21 - problem with 661.6
144 I RMPR6I("VENDOR")'=RMPRC6I("VENDOR") G REVIB
145 ;
146 ; Update the current stock record
147 K RMPR
148 S RMPR("QUANTITY")=RMPR7I("QUANTITY")+RMPRC6I("QUANTITY")
149 S RMPR("VALUE")=RMPR7I("VALUE")+RMPRC6I("VALUE")
150 S RMPR("IEN")=RMPR7I("IEN")
151 S RMPRERR=$$UPD^RMPRPIX7(.RMPR,)
152 I RMPRERR S RMPRERR=31 G REVIX ;error 31 - problem with 661.7
153 G REVID ;now update 661.9 and exit
154 ;
155 ; If we get here there was no current stock record to update
156 ; so create one.
157REVIC K RMPR,RMPR7
158 S RMPR("STATION")=RMPRC6I("STATION")
159 S RMPR("HCPCS")=RMPRC6I("HCPCS")
160 S RMPR("ITEM")=RMPRC6I("ITEM")
161 S RMPR7("DATE&TIME")=$G(RMPRC6I("DATE&TIME"))
162 S RMPR7("SEQUENCE")=RMPRC6I("SEQUENCE")
163 S RMPR7("LOCATION")=RMPRC6I("LOCATION")
164 S RMPR7("QUANTITY")=RMPRC6I("QUANTITY")
165 S RMPR7("VALUE")=RMPRC6I("VALUE")
166 S RMPRERR=$$CRE^RMPRPIX7(.RMPR7,.RMPR)
167 I RMPRERR S RMPRERR=31 G REVIX
168 ;
169 ; Update 661.9 'running balance file' and exit
170REVID S RMPR9("STA")=RMPRC6I("STATION")
171 S RMPR9("HCP")=RMPRC6I("HCPCS")
172 S RMPR9("ITE")=RMPRC6I("ITEM")
173 S RMPR9("RDT")=$P(RMPRC6I("DATE&TIME"),".",1)
174 S RMPR9("TQTY")=RMPRC6I("QUANTITY")
175 S RMPR9("TCST")=RMPRC6I("VALUE")
176 S RMPRERR=$$UPCR^RMPRPIXJ(.RMPR9) ;error 41 - problem with 661.9
177 I RMPRERR S RMPRERR=41 G REVIX
178REVIX L -^RMPR(661.7,"XSLHIDS",RMPRC6I("STATION"),RMPRC6I("LOCATION"),RMPRC6I("HCPCS"),RMPRC6I("ITEM"))
179 Q RMPRERR
Note: See TracBrowser for help on using the repository browser.