source: WorldVistAEHR/trunk/r/HEALTH_LEVEL_SEVEN-HL/HLUCM001.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: 7.4 KB
Line 
1HLUCM001 ;CIOFO-O/LJA - HL7/Capacity Mgt API (continued) ;2/27/01 10:15
2 ;;1.6;HEALTH LEVEL SEVEN;**79,88,103**;Oct 13, 1995
3 ;
4ADDTMP ; Accumulate totals into ^TMP(TOTALS,$J,...)
5 ; FAC,ORIGETM,ORIGSTM,TYPEHR,TYPEIO,TYPELR -- req
6 ;
7 N CHAR,ERRFLAG,FAC,SEC,START,TOTCURR,TYPEHR,TYPEIO,TYPELR
8 ;
9 S CHAR=$G(DATA("CHAR")),SEC=$G(DATA("DIFF")),FAC=$G(DATA("FAC"))
10 S TYPEHR=$G(DATA("HR")),TYPEIO=$G(DATA("IO")),TYPELR=$G(DATA("LR"))
11 ;
12 S START=$$HR($G(DATA("START")))
13 ;I START<ORIGSTM S START=ORIGSTM
14 ;I START>ORIGETM S START=ORIGETM
15 ;
16 ; Back door way to total by day only. (Dropping HR).
17 I $D(^TMP($J,"HLUCMDT")) S START=START\1
18 ;
19 ; Is delta time greater than 30 minutes?
20 S ERRFLAG=0
21 I SEC>1799 D
22 . S X=TOTALS N TOTALS S TOTALS=X_"ERRTIME",ERRFLAG=1
23 . D ERRMOVE^HLUCM009(+IEN772) ; Move into ^TMP($J,"HLUCMSTORE","ERR")
24 ; Store under TOTALS_ERRTIME
25 ;
26 ; Maybe, this IEN772 has already been ERRd by ERRMOVE^HLUCM009?
27 I $D(^TMP($J,"HLUCMSTORE","ERR","X",+IEN772)) D QUIT ;->
28 . D ERRMOVE^HLUCM009(+IEN772) ; Just to be sure
29 ;
30 ; Should this entry even be counted?
31 I (HLAPI="CMF"!(HLAPI="CM2F"))&(TYPELR'="R") QUIT ;->
32 ;
33 ; Accumulating and totaling here...
34 I TYPELR="R" D ACCUMFAC^HLUCM090
35 D ACCUMHR
36 D ACCUMSP
37 D ACCUMPR
38 D TOTALING
39 ;
40 Q
41 ;
42TOTALING ; Grand totals
43 S TOTCURR=$G(^TMP(TOTALS,$J))
44 S $P(TOTCURR,U)=$P(TOTCURR,U)+DATA("CHAR")
45 I $G(HLUCMADD)'="DON'T ADD. COLLECT3~HLUCM003" D
46 . S $P(TOTCURR,U,2)=$P(TOTCURR,U,2)+1
47 S $P(TOTCURR,U,3)=$P(TOTCURR,U,3)+DATA("DIFF")
48 S $P(TOTCURR,U,4)=$P(TOTCURR,U,4)+1
49 S ^TMP(TOTALS,$J)=TOTCURR
50 Q
51 ;
52ACCUMHR ; Hour totaling
53 ; DATA(),FAC,START,TYPEHR -- req
54 ;
55 I HLAPI="CM"!(HLAPI="CM2") D ACCUMLAT^HLUCM009("HR","TM",TYPEHR,START,DATA("PCKG"),DATA("PROT"))
56 I HLAPI="CMF"!(HLAPI="CM2F") D ACCUMLAT^HLUCM009("HR","TM",TYPEHR,FAC,START,DATA("PCKG"),DATA("PROT"))
57 ;
58 ; Total level CATEGORY
59 S TOTCURR=$G(^TMP(TOTALS,$J,"HR"))
60 D INCR
61 S ^TMP(TOTALS,$J,"HR")=TOTCURR
62 ;
63 QUIT
64 ;
65ACCUMSP ; Namespace totaling
66 ; DATA(),FAC,TYPEIO,TYPELR -- req
67 ;
68 I HLAPI="CM"!(HLAPI="CM2") D
69 . D ACCUMLAT^HLUCM009("NMSP","IO",TYPEIO,DATA("PCKG"),START,DATA("PROT"))
70 . D ACCUMLAT^HLUCM009("NMSP","LR",TYPELR,DATA("PCKG"),START,DATA("PROT"))
71 I HLAPI="CMF"!(HLAPI="CM2F") D
72 . D ACCUMLAT^HLUCM009("NMSP","IO",TYPEIO,FAC,DATA("PCKG"),START,DATA("PROT"))
73 . D ACCUMLAT^HLUCM009("NMSP","LR",TYPELR,FAC,DATA("PCKG"),START,DATA("PROT"))
74 ;
75 ; Total level CATEGORY
76 S TOTCURR=$G(^TMP(TOTALS,$J,"NMSP"))
77 D INCR
78 S ^TMP(TOTALS,$J,"NMSP")=TOTCURR
79 ;
80 QUIT
81 ;
82ACCUMPR ; Protocol totaling...
83 ; DATA(),FAC,START -- req
84 ;
85 I HLAPI="CM"!(HLAPI="CM2") D ACCUMLAT^HLUCM009("PROT","PR","P",DATA("PROT"),DATA("PCKG"),START)
86 I HLAPI="CMF"!(HLAPI="CM2F") D ACCUMLAT^HLUCM009("PROT","PR","P",FAC,DATA("PROT"),DATA("PCKG"),START)
87 ;
88 ; Total level CATEGORY
89 S TOTCURR=$G(^TMP(TOTALS,$J,"PROT"))
90 D INCR
91 S ^TMP(TOTALS,$J,"PROT")=TOTCURR
92 ;
93 QUIT
94 ;
95INCR ; Increment totals in TOTCURR...
96 ; CHAR,SEC -- req
97 S $P(TOTCURR,U)=$P(TOTCURR,U)+CHAR ; Number characters
98 I $G(HLUCMADD)'="DON'T ADD. COLLECT3~HLUCM003" D
99 . S $P(TOTCURR,U,2)=$P(TOTCURR,U,2)+1
100 S $P(TOTCURR,U,3)=$P(TOTCURR,U,3)+SEC ; Processing seconds
101 S $P(TOTCURR,U,4)=$P(TOTCURR,U,4)+1
102 QUIT
103 ;
104HR(FMDT) ; Return FM DATE and HOUR only...
105 N HR
106 S FMDT=$G(FMDT)
107 I FMDT'?7N&(FMDT'?7N1"."1.N) QUIT "" ;->
108 S:FMDT'["." FMDT=FMDT_"."
109 S FMDT=$E(FMDT_"00",1,10) ; .00 thru .23 now...
110 S HR=+$P(FMDT,".",2)+1
111 S:HR<10 HR=0_HR S:HR>24 HR=24
112 QUIT (FMDT\1)_"."_HR
113 ;
114OKPAR101(PAR) ; PAR=IEN101...
115 N RET,VAL
116 ;
117 I PAR=1!(PAR=2) QUIT PAR ;->
118 I PAR="0^9999999" QUIT PAR ;->
119 ;
120 ; Passed as 0^IEN or 0^PROTOCOL NAME...
121 S VAL=$P(PAR,U,2)
122 ;
123 ; Was IEN passed?
124 I VAL=+VAL D QUIT RET ;->
125 . S RET=""
126 . I $D(^ORD(101,+VAL,0)) S RET=PAR
127 . I '$D(^ORD(101,+VAL,0)) QUIT ;-> Leaving RET=""
128 ;
129 ; Name was passed... (Can be up to 63 characters long...)
130 ; Find IEN for name...
131 S VAL=$$FIND101(PAR)
132 ;
133 ; If VAL=IEN, reset IEN101 to 0^IEN format...
134 I VAL>0 QUIT "0^"_+VAL ;->
135 ;
136 QUIT ""
137 ;
138TYPELR(IEN772,FACNM) ; Is this Local or Remote or Unknown?
139 ; SITENM -- req
140 N D772,I773,IEN,IEN870,IO,MIEN,NM,TXT,TYPE,X
141 ;
142 ; If SITENM=FACNM, then it isn't remote...
143 I $G(SITENM)]"",$G(FACNM)]"",SITENM=FACNM QUIT "L" ;->
144 ;
145 S D772=$G(^HL(772,+IEN772,0))
146 ;
147 ; Mailman check...
148 S MIEN=$P(D772,U,5) ; get Mailman IEN...
149 I MIEN S X=$$MAILTYPE^HLUCM009(MIEN) QUIT:X="R" $$SLR(IEN772,"R") ;-> Mailman, and remote...
150 ;
151 ; Additional mail check...
152 I $$MAIL870^HLUCM090(IEN772)="R" QUIT $$SLR(IEN772,"R") ;->
153 ;
154 ; Institution check...
155 I $$INST870^HLUCM090(+IEN772,+$P($$SITE^VASITE,U,3))="R" QUIT $$SLR(IEN772,"R") ;->
156 ;
157 ; MSH segment in 773 check...
158 S TYPE="L",I773=0
159 F S I773=$O(^HLMA("B",IEN772,I773)) Q:'I773!(TYPE'="L") D
160 . N DIV,P4,P6
161 . S TXT="",MIEN=0
162 . F S MIEN=$O(^HLMA(+I773,"MSH",MIEN)) Q:MIEN'>0 D
163 . . S TXT=TXT_$G(^HLMA(+I773,"MSH",+MIEN,0))
164 . QUIT:TXT']"" ;->
165 . S X=$$SITESMSH^HLUCM009(TXT),P4=$P(X,U),P6=$P(X,U,2)
166 . S:P4'=P6 TYPE="R"
167 ;
168 ; Was anything found?
169 QUIT:TYPE'="L" $$SLR(IEN772,TYPE) ;->
170 ;
171 ; Logical links check...
172 S IEN870=$$IEN870^HLUCM009(+IEN772) I IEN870 D
173 . N DATA,MGIEN
174 . S DATA=$G(^HLCS(870,+IEN870,0))
175 . QUIT:$P(DATA,U,3)'=1 ;-> Not MAIL...
176 . S MGIEN=$P($G(^HLCS(870,+IEN870,100)),U) QUIT:MGIEN'>0 ;->
177 . ; If a MAIL type link and there is an associated mail group,
178 ; ; it is almost always REMOTE. Enough so, that "R" will be assumed.
179 . ; QUIT:$O(^XMB(3.8,+MGIEN,6,0))'>0 ;-> No remote groups
180 . S TYPE="R"
181 . ; Rare to hit this point.
182 ;
183 QUIT $$SLR(IEN772,TYPE)
184 ;
185SLR(IEN772,LR) ; Store the L/R type for use for FACILITY sorting
186 N FAC,HLDATA,PARENT,TYPE,X
187 Q LR
188 ;
189PREPARE() ; Called by $$CM & $$CM2 and other APIs...
190 ;
191 S ORIGSTM=$G(START),ORIGETM=$G(END)
192 S SITENM=$P($$SITE^VASITE,U,2)
193 ;
194 ; Summarize by DAY instead of hour?
195 I ORIGSTM?7N,ORIGETM']"" D
196 . S ^TMP($J,"HLUCMDT")=""
197 . S ORIGETM=ORIGSTM_".24"
198 ;
199 D ZEROUP
200 ;
201 ; Miscellaneous KILLs...
202 D KILLS^HLUCM009("START")
203 ;
204 ; Build namespace xref
205 D NMSPXRF^HLUCM009
206 ;
207 ; This is where results are returned to caller...
208 KILL ERRINFO
209 ;
210 ; Perform all setup chores. If errors found, they will be placed
211 ; in ERRINFO(ERROR-REASON)="" array
212 QUIT:$$SETUP^HLUCM009 "" ;-> Some errors occurred...
213 ;
214 Q 1
215 ;
216ZEROUP ; If didn't add 0^...
217 I $G(IEN101)]"",IEN101'?1N,IEN101'?1"0^".E S IEN101="0^"_IEN101
218 I $G(PNMSP)]"",PNMSP'?1N,PNMSP'?1"0^".E S PNMSP="0^"_PNMSP
219 Q
220 ;
221FIND101(VAL) ; No checking for upp/lowercase. Must be passed right!
222 ; VAL = Protocol name...
223 N FIEN,IEN,LNM,PNM
224 ;
225 S VAL=$P(VAL,"0^",2)
226 ;
227 ; Passed as IEN?
228 I VAL=+VAL,$D(^ORD(101,+VAL,0)) QUIT +VAL ;->
229 ;
230 ; Passed as NAME?
231 S FIEN=0
232 S LNM=$E(VAL,1,$S($L(VAL)>30:29,1:$L(VAL)-1))
233 F S LNM=$O(^ORD(101,"B",LNM)) Q:LNM]VAL!(LNM']"")!(FIEN) D
234 . S IEN=0
235 . F S IEN=$O(^ORD(101,"B",LNM,IEN)) Q:IEN'>0!(FIEN) D
236 . . QUIT:$P($G(^ORD(101,+IEN,0)),U)'=VAL ;->
237 . . S FIEN=+IEN
238 QUIT $S(FIEN:FIEN,1:"")
239 ;
240REFPROT(PROT) ; If passed by reference, is PROT in array? 0=Don't count, 2=Count
241 ; PROTYPE -- req
242 N X
243 I PROTYPE'=1 QUIT 1 ;-> Not passed by reference...
244 S X=$P(PROT,"~") I X]"" I $D(IEN101(X)) QUIT 1 ;-> found by name in array
245 S X=$P(PROT,"~",2) I X]"" I $D(IEN101(+X)) QUIT 1 ;-> found by IEN in array
246 QUIT ""
247 ;
248REFPCKG(PCKG) ; If passed by reference, is PCKG in array? 0=Don't count,1=OK to count
249 ; NMSPTYPE -- req
250 I NMSPTYPE'=1 QUIT 1 ;-> Not passed by reference...
251 I PCKG]"" I $D(PNMSP(PCKG)) QUIT 1 ;-> found in array
252 QUIT ""
253 ;
254EOR ; HLUCM001 - HL7/Capacity Mgt API (continued) ;2/27/01 10:15
Note: See TracBrowser for help on using the repository browser.