source: FOIAVistA/tag/r/CAPACITY_MANAGEMENT_TOOLS-KMPD-KMPL/KMPDHU03.m

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

initial load of FOIAVistA 6/30/08 version

File size: 5.7 KB
Line 
1KMPDHU03 ;OAK/RAK - CM Tools Compile & File HL7 Daily Stats ;2/17/04 08:59
2 ;;2.0;CAPACITY MANAGEMENT TOOLS;;Mar 22, 2002
3 ;
4COMPILE ;-compile synchronous data into GLB1
5 ;-----------------------------------------------------------------------
6 ; DATA.... data from GBL array
7 ; DATE.... date.hr
8 ; ND...... node where data will be filed in file #8973.1
9 ; LC...... up-arrow (^) piece location of data to be filed
10 ; NM....... namespace
11 ; PT...... protocol name~ien
12 ; PTNP.... prime time - 1
13 ; non-prime time 2
14 ;-----------------------------------------------------------------------
15 ;
16 N DATA,DATE,I,ND,LC,NM,PT,PTNP
17 ;
18 Q:'$D(@GBL@(SS1,SS2,SS3,SS4,SS5,SS6)) S DATA=$G(^(SS6)) Q:DATA=""
19 ; namespace
20 S NM=$S(SS1="HR"!(SS1="PROT"):SS5,SS1="NMSP":SS4,1:"") Q:NM=""
21 ; protocol
22 S PT=$S(SS1="HR"!(SS1="NMSP"):SS6,SS1="PROT":SS4,1:"") Q:PT=""
23 ; prime time - 1, non-prime time - 2
24 S DATE=$S(SS1="HR":SS4,SS1="NMSP":SS5,SS1="PROT":SS6,1:"") Q:'DATE
25 ; DATE is set by using the 'next highest' hour
26 ; 3030509.0811 is returned as 3030509.09
27 ; use $$fmadd to go back to previous hour
28 S PTNP=$$PTNP^KMPDHU03($$FMADD^XLFDT(DATE,,-1)) Q:'PTNP
29 ;
30 I SS1="HR" D
31 .S ND=$S(SS2="TM":1,1:""),ND=ND+(PTNP-1)
32 .S LC=$S(SS3="T":0,SS3="M":3,SS3="U":6,1:"")
33 I SS1="NMSP" D
34 .S ND=$S(SS2="IO":1.1,SS2="LR":1.2,1:""),ND=ND+(PTNP-1)
35 .S LC=$S(SS3="I"!(SS3="L"):0,SS3="O"!(SS3="R"):3,SS3="U":6,1:"") Q:LC=""
36 I SS1="PROT" D
37 .S ND=99,LC=$S(PTNP=1:0,PTNP=2:3,1:"")
38 ;
39 ; quit if not node (ND) or location (LC)
40 Q:'$P(DATE,".")!('ND)!(LC="")
41 ;
42 F I=1,3 D
43 .S $P(@GBL1@($P(DATE,"."),PT,NM,ND),U,(I+LC))=$P($G(@GBL1@($P(DATE,"."),PT,NM,ND)),U,(I+LC))+$P(DATA,U,I)
44 S $P(@GBL1@($P(DATE,"."),PT,NM,ND),U,(2+LC))=$P($G(@GBL1@($P(DATE,"."),PT,NM,ND)),U,(2+LC))+$P(DATA,U,4)
45 ;
46 Q
47 ;
48FILE(KMPDSYNC) ;-file data into file 8973.1 (CM HL7 DATA)
49 ;-----------------------------------------------------------------------
50 ; KMPDSYNC... 1 - synchronous
51 ; 2 - asynchronous
52 ;-----------------------------------------------------------------------
53 Q:'$G(KMPDSYNC)
54 Q:KMPDSYNC<1!(KMPDSYNC>2)
55 Q:'$D(@GBL1)
56 ;
57 W:'$D(ZTQUEUED) !,"Filing ",$S(KMPDSYNC=2:"asynchronous",1:"synchronous")," HL7 stats into file 8973.1 (CM HL7 DATA)..."
58 ;
59 ; file data
60 D @("FILE"_KMPDSYNC) Q:'$D(FDA)
61 ;
62 Q
63 ;
64FILE1 ;-- file synchronous data
65 ;
66 Q:'$D(@GBL1)
67 ;
68 N DATE,ERROR,FDA,I,IEN,INDEX,NM,PT,PT1,ZIEN
69 ;
70 S DATE=0
71 F S DATE=$O(@GBL1@(DATE)) Q:'DATE S PT="" D
72 .F S PT=$O(@GBL1@(DATE,PT)) Q:PT="" S NM="" D
73 ..; remove ien (name~123) from protocol
74 ..S PT1=$P(PT,"~") Q:PT1=""
75 ..F S NM=$O(@GBL1@(DATE,PT,NM)) Q:NM="" S ND=0 D
76 ...K ERROR,FDA,IEN,ZIEN
77 ...; determine if data has already been filed (if ien)
78 ...S IEN=$O(^KMPD(8973.1,"APTDTNM",PT1,DATE,NM,0))
79 ...; if filed set IEN="ien," - edit entry
80 ...; if not filed set IEN="+1," - add entry
81 ...S IEN=$S(IEN:IEN_",",1:"+1,")
82 ...S FDA($J,8973.1,IEN,.01)=DATE
83 ...S FDA($J,8973.1,IEN,.03)=NM
84 ...S FDA($J,8973.1,IEN,.05)=PT1
85 ...S FDA($J,8973.1,IEN,.06)=1
86 ...F S ND=$O(@GBL1@(DATE,PT,NM,ND)) Q:'ND D
87 ....S DATA=@GBL1@(DATE,PT,NM,ND) Q:DATA=""
88 ....S INDEX=$S(ND=99:6,ND=99.2:13,ND=99.5:3,$E(ND)=5:24,1:9)
89 ....F I=1:1:INDEX S:$P(DATA,U,I)'="" FDA($J,8973.1,IEN,ND+(I*.001))=$P(DATA,U,I)
90 ...; file data
91 ...D UPDATE^DIE("","FDA($J)","ZIEN","ERROR")
92 ...; if error
93 ...I $D(ERROR) D
94 ....D MSG^DIALOG("HA",.KMPDERR,60,5,"ERROR")
95 ....D EMAIL^KMPDUTL2("CM TOOLS - HL7 DAILY Error","KMPDERR(")
96 ;
97 Q
98 ;
99FILE2 ;-- file asynchronous data
100 ;
101 Q:'$D(@GBL1)
102 ;
103 N CF,DATE,ERROR,I,IEN,INDEX1,INDEX2,KMPDERR,NM,PT,PT1,ZIEN
104 ;
105 K ^TMP($J,"KMPDHU03-F2")
106 S DATE=0
107 F S DATE=$O(@GBL1@(DATE)) Q:'DATE S PT="" D
108 .F S PT=$O(@GBL1@(DATE,PT)) Q:PT="" S NM="" D
109 ..; remove ien (name~123) from protocol
110 ..S PT1=$P(PT,"~") Q:PT1=""
111 ..F S NM=$O(@GBL1@(DATE,PT,NM)) Q:NM="" S CF="" D
112 ...F S CF=$O(@GBL1@(DATE,PT,NM,CF)) Q:CF="" S ND=0 D
113 ....K ERROR,IEN,ZIEN,^TMP($J,"KMPDHU03-F2"),^TMP($J,"KMPDHU03-ERROR")
114 ....; determine if data has already been filed (if ien)
115 ....S IEN=$O(^KMPD(8973.1,"ACSDTPRNM",CF,DATE,PT1,NM,0))
116 ....; if filed set IEN="ien," - edit entry
117 ....; if not filed set IEN="+1," - add entry
118 ....S IEN=$S(IEN:IEN_",",1:"+1,")
119 ....; date
120 ....S ^TMP($J,"KMPDHU03-F2",8973.1,IEN,.01)=DATE
121 ....; namespace
122 ....S ^TMP($J,"KMPDHU03-F2",8973.1,IEN,.03)=NM
123 ....; protocol
124 ....S ^TMP($J,"KMPDHU03-F2",8973.1,IEN,.05)=PT1
125 ....; 2 = asynchronous
126 ....S ^TMP($J,"KMPDHU03-F2",8973.1,IEN,.06)=2
127 ....F S ND=$O(@GBL1@(DATE,PT,NM,CF,ND)) Q:'ND D
128 .....S DATA=@GBL1@(DATE,PT,NM,CF,ND) Q:DATA=""
129 .....; starting index
130 .....S INDEX1=1 ;$S($E(ND)=5:9,1:1)
131 .....; ending index
132 .....S INDEX2=$S(ND=99:6,ND=99.2:13,ND=99.3:9,ND=99.5:3,$E(ND)=5:24,$E(ND)=6:24,1:0)
133 .....Q:'INDEX2
134 .....F I=INDEX1:1:INDEX2 S:$P(DATA,U,I)'="" ^TMP($J,"KMPDHU03-F2",8973.1,IEN,ND+(I*.001))=$P(DATA,U,I)
135 ....;file data
136 ....D UPDATE^DIE("",$NA(^TMP($J,"KMPDHU03-F2")),"ZIEN","ERROR")
137 ....; if error
138 ....I $D(ERROR) D
139 .....D MSG^DIALOG("HA",.KMPDERR,60,5,"ERROR")
140 .....D EMAIL^KMPDUTL2("CM TOOLS - HL7 DAILY Error","KMPDERR(")
141 ;
142 K ^TMP($J,"KMPDHU03-F2")
143 ;
144 Q
145 ;
146PTNP(DATE) ;-extrinsic function - determine if date.hr is prime time or non-prime time
147 ;-----------------------------------------------------------------------
148 ; DATE.... Date.Time in internal FileMan format
149 ;
150 ; Return: 1 - prime time
151 ; 2 - non-prime time
152 ; "" - unable to identify
153 ;-----------------------------------------------------------------------
154 Q:'$G(DATE) ""
155 N DOW,HOUR
156 ; day of week in numeric format
157 S DOW=$$DOW^XLFDT(DATE,1)
158 ; hours
159 S HOUR=$E($P(DATE,".",2),1,2)
160 ; prime time - not saturday or sunday or holiday and between the hours
161 ; of 8am (0800) to 5 pm (1700)
162 Q:DOW'=0&(DOW'=6)&('$G(^HOLIDAY($P(DATE,"."),0)))&(HOUR>7)&(HOUR<17) 1
163 ; non-prime time
164 Q 2
Note: See TracBrowser for help on using the repository browser.