source: FOIAVistA/trunk/r/CAPACITY_MANAGEMENT_TOOLS-KMPD-KMPL/KMPDHU02.m@ 1499

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

initial load of FOIAVistA 6/30/08 version
File size: 9.0 KB
Line 
1KMPDHU02 ;OAK/RAK - CM Tools Compile & File HL7 Daily Stats ;2/17/04 08:58
2 ;;2.0;CAPACITY MANAGEMENT TOOLS;;Mar 22, 2002
3 ;
4DAILY(KMPDST,KMPDEN) ;-entry point
5 ;-----------------------------------------------------------------------
6 ; KMPDST... Start date in internal fileman format.
7 ; KMPDEN... End date in internal fileman format.
8 ;
9 ; This API gathers HL7 data and stores it in file 8973.1 (CM HL7 DATA)
10 ;
11 ; Variables used:
12 ; GBL...... Global where data is stored - for use with indirection
13 ; GBL1..... globas where compiled data is stored before filing -
14 ; used with indirection
15 ;-----------------------------------------------------------------------
16 ;
17 Q:'$G(KMPDST)
18 Q:'$G(KMPDEN)
19 ; make sure end date has hours
20 S:'$P(KMPDEN,".",2) $P(KMPDEN,".",2)="99"
21 S:'$G(DT) DT=$$DT^XLFDT
22 ;
23 N ERROR,GBL,GBL1,STR,X
24 ;
25 ; get data from hl7 api
26 W:'$D(ZTQUEUED) !,"Gathering HL7 data..."
27 ; global with 'raw' hl7 api data
28 S GBL=$NA(^TMP("KMPDH",$J)) K @GBL
29 ; set up global to get asynchronous data
30 K ^TMP($J)
31 S ^TMP($J,"HLUCM")="DEBUG GLOBAL"
32 S X=$$CM2^HLUCM(KMPDST,KMPDEN,1,1,"KMPDH","EITHER",.ERROR)
33 I 'X!($D(ERROR))!('$D(^TMP("KMPDH",$J))) D Q
34 .W:'$D(ZTQUEUED) " no data to report"
35 ;
36 ; global for storing compiled data before filing
37 S GBL1=$NA(^TMP("KMPDH-1",$J)) K @GBL1
38 ;
39 W:'$D(ZTQUEUED) !,"Compiling synchronous HL7 data..."
40 D SYNC
41 ;
42 W:'$D(ZTQUEUED) !,"Compiling asynchronous HL7 data..."
43 D ASYNC
44 ;
45 K @GBL,@GBL1,^TMP($J),^TMP("KMPDHERRTIME",$J)
46 W:'$D(ZTQUEUED) !,"Finished!"
47 ;
48 Q
49 ;
50 ;
51ASYNC ;- asynchronous data
52 Q:$G(GBL)=""
53 Q:$G(GBL1)=""
54 ;
55 N COUNT,DATA,DATA1,DATA2,HOUR,I,IEN,IEN1,IEN2,J,LOCAL,MSG,NM,NODE
56 N OF,PIECE,PR,PTNP,SD,STDT,TIME1,TIME2,UNIT
57 ;
58 ; local site name
59 S LOCAL=$P($$SITE^VASITE,U,2) Q:LOCAL=""
60 S IEN=0
61 F S IEN=$O(^TMP($J,"HLUCMSTORE","U",IEN)) Q:'IEN S DATA=^(IEN) D
62 .; data = Protocol~Ien^Namespace
63 .; message type
64 .S MSG=$P(DATA,U,6)
65 .; quit if not 'complete' message
66 .Q:'$$ASYNCHK(MSG)
67 .; protocol - check protocol fist, then inferred protocol
68 .S PR=$S($P(DATA,U,7)]"":$P(DATA,U,7),$P(DATA,U,8)]"":$P(DATA,U,8),1:"") Q:PR=""
69 .; namespace - check namespace first, then inferred namespace
70 .S NM=$S($P(DATA,U,9)]"":$P(DATA,U,9),$P(DATA,U,10)]"":$P(DATA,U,10),1:"") Q:NM=""
71 .; other facility
72 .S OF=$P(DATA,U,11) S:OF["~" OF=$P(OF,"~",2) Q:OF=""
73 .; quit if other facility is LOCAL
74 .Q:OF[LOCAL
75 .; start date/time
76 .S STDT=$P(DATA,U,4) Q:'STDT
77 .; date without time
78 .S SD=$P(STDT,".") Q:'SD
79 .S $P(@GBL1@(SD,PR,NM,OF,99.2),U,11)=$P($P(DATA,U,11),"~")
80 .S $P(@GBL1@(SD,PR,NM,OF,99.2),U,12)=$P($P(DATA,U,11),"~",2)
81 .S $P(@GBL1@(SD,PR,NM,OF,99.2),U,13)=$P($P(DATA,U,11),"~",3)
82 .;
83 .S (COUNT,HOUR,IEN1)=0 K UNIT
84 .F S IEN1=$O(^TMP($J,"HLUCMSTORE","U",IEN,IEN1)) Q:'IEN1 D
85 ..; data1 = piece 1 - Characters
86 ..; piece 2 - Messages
87 ..; piece 3 - Seconds
88 ..; piece 4 - Begining Time
89 ..; piece 5 - End Time
90 ..; piece 6 - Type: msg, ca, aa or ca
91 ..; piece 7 - Protocol~Ien
92 ..; piece 8 - Namespace
93 ..S DATA1=$G(^TMP($J,"HLUCMSTORE","U",IEN,IEN1,"CCC")) Q:DATA1=""
94 ..S COUNT=COUNT+1,UNIT(COUNT)=DATA1
95 .;
96 .; back to IEN level
97 .; quit if unit() array is not complete
98 .Q:'$$UNITS(MSG)
99 .; hour of transaction
100 .S HOUR=+$E($P(STDT,".",2),1,2),HOUR=HOUR+1
101 .; prime time or non-prime time
102 .S PTNP=$$PTNP^KMPDHU03(STDT) Q:'PTNP
103 .; node: 5 - prime time
104 .; 6 - non-prime time
105 .S NODE=$S(PTNP=2:6,1:5)
106 .;
107 .; update msg unit count - prime time or non-prime time
108 .S $P(@GBL1@(SD,PR,NM,OF,99.5),U,PTNP)=$P($G(@GBL1@(SD,PR,NM,OF,99.5)),U,PTNP)+1
109 .;update msg unit count - both prime time & non-prime time
110 .S $P(@GBL1@(SD,PR,NM,OF,99.5),U,3)=$P($G(@GBL1@(SD,PR,NM,OF,99.5)),U,3)+1
111 .; totals
112 .F J=0:0 S J=$O(UNIT(J)) Q:'J F I=1:1:3 D
113 ..; total
114 ..S $P(@GBL1@(SD,PR,NM,OF,99.2),U,I)=$P($G(@GBL1@(SD,PR,NM,OF,99.2)),U,I)+$P(UNIT(J),U,I)
115 ..S $P(@GBL1@(SD,PR,NM,OF,99.3),U,(I+6))=$P($G(@GBL1@(SD,PR,NM,OF,99.3)),U,(I+6))+$P(UNIT(J),U,I)
116 ..; prime time or non-prime time
117 ..; ^ piece to set
118 ..S PIECE=I+$S(PTNP=2:3,1:0)
119 ..S $P(@GBL1@(SD,PR,NM,OF,99.3),U,PIECE)=$P($G(@GBL1@(SD,PR,NM,OF,99.3)),U,PIECE)+$P(UNIT(J),U,I)
120 .;
121 .; msg to ca - originating message to commit ack
122 .; ^ piece: 1 - characters
123 .; 2 - count
124 .; 3 - seconds
125 .F I=1:1:3 S $P(@GBL1@(SD,PR,NM,OF,NODE+(I*.1)),U,HOUR)=$P($G(@GBL1@(SD,PR,NM,OF,NODE+(I*.1))),U,HOUR)+($P(UNIT(1),U,I)+$P(UNIT(2),U,I))
126 .;
127 .; processing time (ca to aa) - commit ack ending time to application
128 .; ack starting time
129 .S TIME1=+$P(UNIT(3),U,4),TIME2=+$P(UNIT(2),U,5)
130 .S $P(@GBL1@(SD,PR,NM,OF,(NODE+(.4))),U,HOUR)=$$TIMEADD^KMPDU($P($G(@GBL1@(SD,PR,NM,OF,(NODE+(.4)))),U,HOUR)+$$FMDIFF^XLFDT(TIME2,(+TIME1),3))
131 .; processing time (ca to aa) - count
132 .S $P(@GBL1@(SD,PR,NM,OF,(NODE+(.5))),U,HOUR)=$P($G(@GBL1@(SD,PR,NM,OF,(NODE+(.5)))),U,HOUR)+1
133 .;
134 .; aa to ca - application ack to commit ack
135 .; ^ piece: 1 - characters
136 .; 2 - count
137 .; 3 - seconds
138 .F I=1:1:3 S $P(@GBL1@(SD,PR,NM,OF,NODE+(I+6*.1)),U,HOUR)=$P($G(@GBL1@(SD,PR,NM,OF,NODE+(I+6*.1))),U,HOUR)+($P(UNIT(3),U,I)+$P(UNIT(4),U,I))
139 ;
140 D:$D(@GBL1) FILE^KMPDHU03(2)
141 ;
142 Q
143 ;
144ASYNCHK(KMPDMSG) ;-- extrinsic function - check for 'complete' message
145 ;-----------------------------------------------------------------------
146 ; KMPDMGS... message ack designations
147 ;
148 ; Return: 0 - not a complete message
149 ; 1 - complete message
150 ;-----------------------------------------------------------------------
151 Q:$G(KMPDMSG)="" 0
152 Q:MSG="MSG~CA~AA~CA" 1
153 Q:MSG="MSG~CA~AR~CA" 1
154 Q:MSG="MSG~AA" 1
155 Q 0
156 ;
157UNITS(MSG) ;-- extrinsic function
158 ;-----------------------------------------------------------------------
159 ; MSG.... type of message: 'msg~aa', 'msg~ca~aa~ca', etc.
160 ;
161 ; Return: 0 - unit() array not complete
162 ; 1 - unit() array is complete
163 ;
164 ; unit() array must be segmented into the following format:
165 ; unit(1) = msg
166 ; unit(2) = ca
167 ; unit(3) = aa
168 ; unit(4) = ca
169 ; this data is then used to calculate characters, messages and seconds
170 ;-----------------------------------------------------------------------
171 Q:$G(MSG)="" 0
172 ; all messages must have unit(2)
173 Q:'$D(UNIT(2)) 0
174 ; "msg~ca~aa~ca" & "msg~ca~ar~ca" messages must have unit(3) & unit(4)
175 I MSG="MSG~CA~AA~CA"!(MSG="MSG~CA~AR~CA") Q:'$D(UNIT(3)) 0
176 I MSG="MSG~CA~AA~CA"!(MSG="MSG~CA~AR~CA") Q:'$D(UNIT(4)) 0
177 ; 'msg~aaa' messages contain only 2 unit() entries
178 ; create 4 unit() entries for processing
179 I MSG="MSG~AA" D
180 .S (UNIT(3),UNIT(4))=UNIT(2),UNIT(2)=UNIT(1)
181 .S $P(UNIT(1),U,1,3)="0^0^0"
182 .S $P(UNIT(4),U,1,3)="0^0^0"
183 ; calculate seconds
184 ; msg to ca
185 S $P(UNIT(2),U,3)=$$FMDIFF^XLFDT($P(UNIT(2),U,5),$P(UNIT(1),U,4),2)
186 S:$P(UNIT(2),U,3)<0 $P(UNIT(2),U,3)=0
187 ; ca to aa
188 S $P(UNIT(3),U,3)=$$FMDIFF^XLFDT($P(UNIT(3),U,5),$P(UNIT(2),U,5),2)
189 S:$P(UNIT(3),U,3)<0 $P(UNIT(3),U,3)=0
190 ; aa to ca
191 S $P(UNIT(4),U,3)=$$FMDIFF^XLFDT($P(UNIT(4),U,5),$P(UNIT(3),U,5),2)
192 S:$P(UNIT(4),U,3)<0 $P(UNIT(4),U,3)=0
193 ;
194 Q 1
195 ;
196SYNC ;- synchronous data
197 ;-----------------------------------------------------------------------
198 ; SS1...... subscript 1 - identifies data
199 ; HR - hourly
200 ; NMSP - namespace
201 ; PROT - protocol
202 ; SS2...... subscript 2 - identifies data sorted within SS1
203 ; IO - incoming/outgoing messages
204 ; LR - local/remote messages
205 ; PR - protocol
206 ; TM - type of transmission
207 ;
208 ; SS3...... subcript 3 - which identifier for SS2 is being sorted
209 ; IO - I - incoming
210 ; O - outgoing
211 ; U - unknown
212 ; LR - L - local
213 ; R - remote
214 ; U - unknown
215 ; PR - P - placeholder for consistent subscripting
216 ; TM - M - mailman
217 ; T - tcp
218 ; U -unknown
219 ; SS4...... subscript 4 - according to SS1
220 ; HR - date.time
221 ; NMSP - namespace
222 ; PROT - protocal
223 ; SS5...... subcript 5 - according to SS1
224 ; HR - namespace
225 ; NMSP - date.tim
226 ; PROT - namespace
227 ; SS6...... subscript 6 - according to SS1
228 ; HR - protocol
229 ; NMSP - protocol
230 ; PROT - date.time
231 ;-----------------------------------------------------------------------
232 Q:$G(GBL)=""
233 Q:$G(GBL1)=""
234 N SS1,SS2,SS3,SS4,SS5,SS6
235 S SS1=""
236 F S SS1=$O(@GBL@(SS1)) Q:SS1="" I SS1'="RFAC" S SS2="" D
237 .F S SS2=$O(@GBL@(SS1,SS2)) Q:SS2="" S SS3="" D
238 ..F S SS3=$O(@GBL@(SS1,SS2,SS3)) Q:SS3="" S SS4="" D
239 ...F S SS4=$O(@GBL@(SS1,SS2,SS3,SS4)) Q:SS4="" S SS5="" D
240 ....Q:SS1="PROT"&(SS4="ZZZ")
241 ....F S SS5=$O(@GBL@(SS1,SS2,SS3,SS4,SS5)) Q:SS5="" S SS6="" D
242 .....; if SS1="NMSP" or SS1="PROT" quit if SS4 and SS5 (protocol/
243 .....; namespace pair) = ZZZ
244 .....I SS1="NMSP"!(SS1="PROT") Q:SS4="ZZZ"&(SS5="ZZZ")
245 .....F S SS6=$O(@GBL@(SS1,SS2,SS3,SS4,SS5,SS6)) Q:SS6="" D
246 ......Q:SS1="HR"&(SS6="ZZZ")
247 ......Q:SS1="NMSP"&(SS6="ZZZ")
248 ......; compile data into daily stats for file #8973.1 (CM HL7 DATA)
249 ......D COMPILE^KMPDHU03
250 ;
251 D:$D(@GBL1) FILE^KMPDHU03(1)
252 ;
253 K @GBL1
254 ;
255 Q
Note: See TracBrowser for help on using the repository browser.