close Warning: Can't use blame annotator: 
svn blame failed on WorldVistAEHR/trunk/r/PROSTHETICS-RMPR-RMPO-RMPS/RMPR5HQ6.m: 'GenericSWIGWrapper' object has no attribute '_wrap'

source: WorldVistAEHR/trunk/r/PROSTHETICS-RMPR-RMPO-RMPS/RMPR5HQ6.m@ 691

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

initial load of WorldVistAEHR
File size: 6.6 KB
RevLine 
1RMPR5HQ6 ;HCIOFO/ODJ - USAGE CALCULATION, LOCAL REPORT ; 20 SEP 00
2 ;;3.0;PROSTHETICS;**51**;Feb 09, 1996
3 Q
4 ;
5 ;Vars. required...
6 ;RMPRSDT
7 ;RMPREDT
8CALC N KEYS,EOF,CHNG,OLD,GTOT,LTOT,HTOT,ITOT,INVREC
9 N X1,X2,DAYS,I,DAYAV,X,QOHU,QOHN
10 D INIT(.KEYS,.EOF,.CHNG) I EOF G CALCX
11 S X2=RMPRSDT,X1=RMPREDT D ^%DTC S DAYS=X+1
12 F Q:EOF D
13 . S:CHNG("STATION") OLD("STATION")=KEYS("STATION")
14 . S:CHNG("NPPD_GROUP") OLD("NPPD_GROUP")=KEYS("NPPD_GROUP"),GTOT=""
15 . S:CHNG("NPPD_LINE") OLD("NPPD_LINE")=KEYS("NPPD_LINE"),LTOT=""
16 . S:CHNG("HCPC_CODE") OLD("HCPC")=KEYS("HCPC"),HTOT=""
17 . I CHNG("HCPC_ITEM") D
18 .. S OLD("HCPC_ITEM")=KEYS("HCPC_ITEM")
19 .. D RDITEM(.KEYS,.ITOT) ;get current quantity on hand and value
20 .. S QOHU=+$P(ITOT,"^",8),QOHN=+$P(ITOT,"^",9)
21 .. Q
22 . D RDINV(.KEYS,.INVREC) ;read inventory
23 . I INVREC("SOURCE")="C" D
24 .. S $P(ITOT,"^",2)=$P(ITOT,"^",2)+INVREC("QTY") ;commercial issue
25 .. S $P(ITOT,"^",5)=$P(ITOT,"^",5)+INVREC("ISSUE COST")
26 .. Q
27 . E D
28 .. S $P(ITOT,"^",1)=$P(ITOT,"^",1)+INVREC("QTY") ;VA issue
29 .. S $P(ITOT,"^",4)=$P(ITOT,"^",4)+INVREC("ISSUE COST")
30 .. Q
31 . D NXINV(.KEYS,.EOF,.CHNG) ;next inventory record in ^TMP
32 . I CHNG("HCPC_ITEM")!EOF D
33 .. S DAYAV=$P(ITOT,"^",2)/DAYS
34 .. S $P(ITOT,"^",6)=DAYAV
35 .. S:DAYAV $P(ITOT,"^",7)=QOHN/DAYAV
36 .. S DAYAV=$P(ITOT,"^",1)/DAYS
37 .. S $P(ITOT,"^",12)=DAYAV
38 .. S:DAYAV $P(ITOT,"^",13)=QOHU/DAYAV
39 .. D UPITEM(.OLD,ITOT) ;update Item totals in ^TMP
40 .. F I=1:1:5,8:1:11 S $P(HTOT,"^",I)=$P(ITOT,"^",I)+$P(HTOT,"^",I)
41 .. Q
42 . I CHNG("HCPC_CODE")!EOF D
43 .. S DAYAV=$P(HTOT,"^",2)/DAYS
44 .. S $P(HTOT,"^",6)=DAYAV
45 .. S:DAYAV $P(HTOT,"^",7)=$P(HTOT,"^",9)/DAYAV
46 .. S DAYAV=$P(HTOT,"^",1)/DAYS
47 .. S $P(HTOT,"^",12)=DAYAV
48 .. S:DAYAV $P(HTOT,"^",13)=$P(HTOT,"^",8)/DAYAV
49 .. D UPHCPC(.OLD,HTOT) ;update HCPC totals in ^TMP
50 .. F I=1:1:5,8:1:11 S $P(LTOT,"^",I)=$P(HTOT,"^",I)+$P(LTOT,"^",I)
51 .. Q
52 . I CHNG("NPPD_LINE")!EOF D
53 .. S DAYAV=$P(LTOT,"^",2)/DAYS
54 .. S $P(LTOT,"^",6)=DAYAV
55 .. S:DAYAV $P(LTOT,"^",7)=$P(LTOT,"^",9)/DAYAV
56 .. S DAYAV=$P(LTOT,"^",1)/DAYS
57 .. S $P(LTOT,"^",12)=DAYAV
58 .. S:DAYAV $P(LTOT,"^",13)=$P(LTOT,"^",8)/DAYAV
59 .. D UPLIN(.OLD,LTOT) ;update NPPD line totals
60 .. S $P(GTOT,"^",4)=$P(LTOT,"^",4)+$P(GTOT,"^",4)
61 .. S $P(GTOT,"^",5)=$P(LTOT,"^",5)+$P(GTOT,"^",5)
62 .. S $P(GTOT,"^",10)=$P(LTOT,"^",10)+$P(GTOT,"^",10)
63 .. S $P(GTOT,"^",11)=$P(LTOT,"^",11)+$P(GTOT,"^",11)
64 .. Q
65 . I CHNG("NPPD_GROUP")!EOF D
66 .. D UPGRP(.OLD,GTOT) ;update NPPD group totals
67 .. Q
68 . Q
69CALCX Q
70 ;
71 ; Read inventory rec
72RDINV(PRIKEY,INVREC) ;
73 N INVIEN,S,TNAM,NPGRP,NPLIN,HCPC,ITEM,STATION
74 S TNAM="RMPR5"
75 S INVIEN=PRIKEY("INVENTORY_IEN")
76 I INVIEN="" S INVREC("QTY")=0,INVREC("SOURCE")="",INVREC("ISSUE COST")=0 Q
77 S STATION=PRIKEY("STATION")
78 S NPGRP=PRIKEY("NPPD_GROUP")
79 S NPLIN=PRIKEY("NPPD_LINE")
80 S HCPC=PRIKEY("HCPC")
81 S ITEM=PRIKEY("HCPC_ITEM")
82 S S=$G(^TMP($J,TNAM,STATION,NPGRP,NPLIN,HCPC,ITEM,INVIEN))
83 K INVREC
84 S INVREC("QTY")=$P(S,"^",1)
85 S INVREC("SOURCE")=$P(S,"^",3)
86 S INVREC("ISSUE COST")=$P(S,"^",2)
87 Q
88RDITEM(PRIKEY,MYSTR) ;
89 N TNAM,NPGRP,NPLIN,HCPC,ITEM,STATION
90 S TNAM="RMPR5"
91 S STATION=PRIKEY("STATION")
92 S NPGRP=PRIKEY("NPPD_GROUP")
93 S NPLIN=PRIKEY("NPPD_LINE")
94 S HCPC=PRIKEY("HCPC")
95 S ITEM=PRIKEY("HCPC_ITEM")
96 S MYSTR=$G(^TMP($J,TNAM,STATION,NPGRP,NPLIN,HCPC,ITEM))
97 Q
98 ;
99 ; Get next inventory record
100NXINV(RMPRKEY,RMPREOF,RMPRCHNG) ;
101 N TNAM,NPGRP,NPLIN,HCPC,ITEM,INVIEN,STATION
102 S TNAM="RMPR5"
103 S STATION=RMPRKEY("STATION")
104 S NPGRP=RMPRKEY("NPPD_GROUP")
105 S NPLIN=RMPRKEY("NPPD_LINE")
106 S HCPC=RMPRKEY("HCPC")
107 S ITEM=RMPRKEY("HCPC_ITEM")
108 S INVIEN=RMPRKEY("INVENTORY_IEN")
109 S RMPREOF=0
110 S RMPRCHNG("STATION")=0
111 S RMPRCHNG("NPPD_GROUP")=0,RMPRCHNG("NPPD_LINE")=0,RMPRCHNG("HCPC_CODE")=0,RMPRCHNG("HCPC_ITEM")=0
112 S INVIEN=$O(^TMP($J,TNAM,STATION,NPGRP,NPLIN,HCPC,ITEM,INVIEN))
113 S:INVIEN="" ITEM=$O(^TMP($J,TNAM,STATION,NPGRP,NPLIN,HCPC,ITEM))
114 S:ITEM="" HCPC=$O(^TMP($J,TNAM,STATION,NPGRP,NPLIN,HCPC))
115 S:HCPC="" NPLIN=$O(^TMP($J,TNAM,STATION,NPGRP,NPLIN))
116 S:NPLIN="" NPGRP=$O(^TMP($J,TNAM,STATION,NPGRP))
117 S:NPGRP="" STATION=$O(^TMP($J,TNAM,STATION))
118 I STATION=""!(STATION="Z") S RMPREOF=1,RMPRCHNG("INVENTORY_IEN")=0 G NXINVX
119 S:NPGRP="" NPGRP=$O(^TMP($J,TNAM,STATION,"")),RMPRCHNG("STATION")=1
120 S:NPLIN="" NPLIN=$O(^TMP($J,TNAM,STATION,NPGRP,"")),RMPRCHNG("NPPD_GROUP")=1
121 S:HCPC="" HCPC=$O(^TMP($J,TNAM,STATION,NPGRP,NPLIN,"")),RMPRCHNG("NPPD_LINE")=1
122 S:ITEM="" ITEM=$O(^TMP($J,TNAM,STATION,NPGRP,NPLIN,HCPC,"")),RMPRCHNG("HCPC_CODE")=1
123 S:INVIEN="" INVIEN=$O(^TMP($J,TNAM,STATION,NPGRP,NPLIN,HCPC,ITEM,"")),RMPRCHNG("HCPC_ITEM")=1
124 S RMPRCHNG("INVENTORY_IEN")=1
125 S RMPRKEY("STATION")=STATION
126 S RMPRKEY("NPPD_GROUP")=NPGRP
127 S RMPRKEY("NPPD_LINE")=NPLIN
128 S RMPRKEY("HCPC")=HCPC
129 S RMPRKEY("HCPC_CODE")=$P(HCPC,"/",1)
130 S RMPRKEY("HCPC_IEN")=$P(HCPC,"/",2)
131 S RMPRKEY("HCPC_ITEM")=ITEM
132 S RMPRKEY("INVENTORY_IEN")=INVIEN
133NXINVX Q
134 ;
135 ; Init. TMP array keys
136INIT(RMPRKEY,RMPREOF,RMPRCHNG) ;
137 N TNAM,NPGRP,NPLIN,HCPC,ITEM,INVIEN,STATION
138 S TNAM="RMPR5"
139 K RMPRKEY
140 S RMPREOF=0
141 S RMPRCHNG("STATION")=0,RMPRCHNG("NPPD_GROUP")=0,RMPRCHNG("NPPD_LINE")=0
142 S RMPRCHNG("HCPC_CODE")=0,RMPRCHNG("HCPC_ITEM")=0,RMPRCHNG("INVENTORY_IEN")=0
143 S STATION=$O(^TMP($J,TNAM,""))
144 I STATION=""!(STATION="Z") S RMPREOF=1 G INITX
145 S RMPRCHNG("STATION")=1,RMPRCHNG("NPPD_GROUP")=1,RMPRCHNG("NPPD_LINE")=1
146 S RMPRCHNG("HCPC_CODE")=1,RMPRCHNG("HCPC_ITEM")=1,RMPRCHNG("INVENTORY_IEN")=1
147 S NPGRP=$O(^TMP($J,TNAM,STATION,""))
148 S NPLIN=$O(^TMP($J,TNAM,STATION,NPGRP,""))
149 S HCPC=$O(^TMP($J,TNAM,STATION,NPGRP,NPLIN,""))
150 S ITEM=$O(^TMP($J,TNAM,STATION,NPGRP,NPLIN,HCPC,""))
151 S INVIEN=$O(^TMP($J,TNAM,STATION,NPGRP,NPLIN,HCPC,ITEM,""))
152 S RMPRKEY("STATION")=STATION
153 S RMPRKEY("NPPD_GROUP")=NPGRP
154 S RMPRKEY("NPPD_LINE")=NPLIN
155 S RMPRKEY("HCPC")=HCPC
156 S RMPRKEY("HCPC_CODE")=$P(HCPC,"/",1)
157 S RMPRKEY("HCPC_IEN")=$P(HCPC,"/",2)
158 S RMPRKEY("HCPC_ITEM")=ITEM
159 S RMPRKEY("INVENTORY_IEN")=INVIEN
160INITX Q
161 ;
162 ; ^TMP updates
163UPGRP(PRIKEY,MYSTR) ;
164 N TNAM,NPGRP,STATION
165 S TNAM="RMPR5"
166 S STATION=PRIKEY("STATION")
167 S NPGRP=PRIKEY("NPPD_GROUP")
168 S ^TMP($J,TNAM,STATION,NPGRP)=MYSTR
169 Q
170UPLIN(PRIKEY,MYSTR) ;
171 N TNAM,NPGRP,NPLIN,STATION
172 S TNAM="RMPR5"
173 S STATION=PRIKEY("STATION")
174 S NPGRP=PRIKEY("NPPD_GROUP")
175 S NPLIN=PRIKEY("NPPD_LINE")
176 S ^TMP($J,TNAM,STATION,NPGRP,NPLIN)=MYSTR
177 Q
178UPHCPC(PRIKEY,MYSTR) ;
179 N TNAM,NPGRP,NPLIN,HCPC,STATION
180 S TNAM="RMPR5"
181 S STATION=PRIKEY("STATION")
182 S NPGRP=PRIKEY("NPPD_GROUP")
183 S NPLIN=PRIKEY("NPPD_LINE")
184 S HCPC=PRIKEY("HCPC")
185 S ^TMP($J,TNAM,STATION,NPGRP,NPLIN,HCPC)=MYSTR
186 Q
187UPITEM(PRIKEY,MYSTR) ;
188 N TNAM,NPGRP,NPLIN,HCPC,ITEM,STATION
189 S TNAM="RMPR5"
190 S STATION=PRIKEY("STATION")
191 S NPGRP=PRIKEY("NPPD_GROUP")
192 S NPLIN=PRIKEY("NPPD_LINE")
193 S HCPC=PRIKEY("HCPC")
194 S ITEM=PRIKEY("HCPC_ITEM")
195 S ^TMP($J,TNAM,STATION,NPGRP,NPLIN,HCPC,ITEM)=MYSTR
196 Q
Note: See TracBrowser for help on using the repository browser.