source: FOIAVistA/trunk/r/HEALTH_LEVEL_SEVEN-HL/HLUCM004.m@ 1397

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

initial load of FOIAVistA 6/30/08 version
File size: 6.8 KB
Line 
1HLUCM004 ;CIOFO-O/LJA - HL7/Capacity Mgt API ;3/13/03 09:37
2 ;;1.6;HEALTH LEVEL SEVEN;*88,103**;Oct 13, 1995
3 ;
4LOOPU ; Loop thru ^TMP($J,"HLUCMSTORE","U") data. Full-screen view...
5 N CT,DATA,EXCL,IEN772,IENPAR,INCL,IOINHI,IOINORM,RNOMSG,STOP,TYPE,X
6 S X="IOINHI;IOINORM" D ENDR^%ZISS
7 ;
8LOOPU1 KILL DATA,EXCL,INCL,IEN772,IENPAR,INCL,RNOMSG,STOP,TYPE
9 W @IOF,$$CJ^XLFSTR("Display of ^TMP($J,""HLUCMSTORE"",""U"") Data",IOM)
10 W !,$$REPEAT^XLFSTR("=",IOM)
11 ;
12 W !!,$$CJ^XLFSTR("Type Totals",IOM)
13 W !,$$CJ^XLFSTR("--------------------------------",IOM)
14 S TYPE=""
15 F S TYPE=$O(^TMP($J,"HLUCMSTORE","T",TYPE)) Q:TYPE']"" D
16 . S DATA=$G(^TMP($J,"HLUCMSTORE","T",TYPE))
17 . W !,$$CJ^XLFSTR(TYPE_" "_DATA,IOM)
18 ;
19 W !!,"Enter text in messages to include and exclude..."
20 W !
21 D EXCL(.EXCL)
22 W !
23 D INCL(.INCL)
24 ;
25 R !!,"Restrict # messages: 999// ",RNOMSG:999
26 S:RNOMSG']"" RNOMSG=999
27 QUIT:RNOMSG'?1.N ;->
28 ;
29 S (CT,CT(1))=0,IENPAR=0,STOP=0
30 F S IENPAR=$O(^TMP($J,"HLUCMSTORE","U",IENPAR)) Q:'IENPAR!(STOP) D
31 . S CT(1)=CT(1)+1
32 . QUIT:'$$OK(+IENPAR,RNOMSG,.EXCL,.INCL) ;->
33 . S CT=CT+1
34 . D SHOWU(+IENPAR,"FULL")
35 . R X:999 I X[U S STOP=1
36 ;
37 I CT(1)'>0 W !!,"No data exists..." H 2
38 ;
39 I CT(1)>0 D
40 . W !!,$S('CT:"No matching entries found...",1:"#"_CT_" matching entries displayed...")
41 . S CT=CT(1)-CT W !,"#"_CT_" entries skipped..."
42 ;
43 Q
44 ;
45OK(IENPAR,RNOMSG,EXCL,INCL) ; Exclude and INcludes..
46 N DATA,FAIL,HOLDEXCL,IEN772,NUM
47 ;
48 ; Count messages...
49 S NUM=0,IEN772=0
50 F S IEN772=$O(^TMP($J,"HLUCMSTORE","U",+IENPAR,IEN772)) Q:'IEN772 D
51 . S NUM=NUM+1
52 ;
53 ; Quit if number messages in unit isn't right...
54 I RNOMSG=999 QUIT:NUM>RNOMSG "" ;-> Should never happen!
55 I RNOMSG'=999 QUIT:NUM'=RNOMSG "" ;->
56 ;
57 ; Parent node check...
58 S DATA=$G(^TMP($J,"HLUCMSTORE","U",+IENPAR))
59 ;
60 ; Exclusions...
61 QUIT:$$HOLDEXCL(DATA,.EXCL) "" ;->
62 ;
63 ; Child nodes check...
64 I $O(EXCL(""))]"" D
65 . S IEN772=0,HOLDEXCL=0
66 . F S IEN772=$O(^TMP($J,"HLUCMSTORE","U",+IENPAR,IEN772)) Q:'IEN772!(HOLDEXCL) D
67 . . S DATA=$$DATA(+IEN772)
68 . . S HOLDEXCL=$$HOLDEXCL(DATA,.EXCL)
69 ;
70 QUIT:$G(HOLDEXCL) "" ;->
71 ;
72 ; Quit, if no INCLUDES...
73 QUIT:$O(INCL(""))']"" 1 ;->
74 ;
75 ; Inclusion check for parent node...
76 QUIT:$$HOLDINCL(DATA,.INCL) 1 ;->
77 ;
78 ; Child node inclusion checks...
79 S IEN772=0,HOLDINCL=0
80 F S IEN772=$O(^TMP($J,"HLUCMSTORE","U",+IENPAR,IEN772)) Q:'IEN772!(HOLDINCL) D
81 . S DATA=$$DATA(+IEN772)
82 . S HOLDINCL=$$HOLDINCL(DATA,.INCL)
83 ;
84 Q HOLDINCL
85 ;
86EXCL(EXCL) ; What entries to exclude? (Searches PARENT node)
87 W !!,"Every parent node that includes one of the EXCLUDE values that you enter now"
88 W !,"will not be included in the entries displayed."
89 W !
90 D ASK("EXCLUDE",.EXCL)
91 Q
92 ;
93HOLDEXCL(DATA,EXCL) ; Includes text that should be excluded?
94 N HOLD
95 S EXCL="",HOLD=0
96 F S EXCL=$O(EXCL(EXCL)) Q:EXCL']""!(HOLD) D
97 . I DATA[EXCL S HOLD=1
98 Q HOLD
99 ;
100INCL(INCL) ; What entries to include? (Searches PARENT node)
101 W !!,"Every parent node that doesn't include one of the INCLUDE values that you"
102 W !,"enter now will not be included in the entries displayed."
103 W !
104 D ASK("INCLUDE",.INCL)
105 Q
106 ;
107HOLDINCL(DATA,INCL) ; Does DATA hold one of the INCLUDEs?
108 N HOLD
109 S INCL="",HOLD=0
110 F S INCL=$O(INCL(INCL)) Q:INCL']""!(HOLD) D
111 . I DATA[INCL S HOLD=1
112 Q HOLD
113 ;
114ASK(TYPE,ENTRY) ; Repeatedly ask...
115 N ANS
116 F D QUIT:ANS']""
117 . W !,TYPE,": "
118 . R ANS:999 S:ANS=U ANS="" Q:ANS']"" ;->
119 . S ENTRY(ANS)=""
120 Q
121 ;
122SHOWU(IENPAR,VIEW) ; Show one entry in VIEW format...
123 N HL,X
124 MERGE HL=^TMP($J,"HLUCMSTORE","U",+IENPAR)
125 S X="D "_VIEW_"(.HL)" X X
126 Q
127 ;
128FULL(HL) ; Display one entry in FULL format...
129 ; IOINHI,IOINORM -- req
130 N COUNT,DATA,DATA4,DATAN,DATAP,DATAR,IEN772,L,LEN
131 N PNO,PROTP,PROTC,RES,STOP
132 ;
133 ; Header...
134 W @IOF
135 S DATA=HL
136 F D Q:DATA']""
137 . W !,$$CJ^XLFSTR($E(DATA,1,70),IOM)
138 . S DATA=$E(DATA,71,999)
139 W !,$$REPEAT^XLFSTR("=",IOM)
140 ;
141 S PROTP=$P(HL,U,7)
142 ;
143 ; Body...
144 S COUNT=0,IEN772=0,STOP=0
145 F S IEN772=$O(HL(IEN772)) Q:'IEN772!(STOP) D
146 . S COUNT=COUNT+1
147 . S DATA=$$DATA(+IEN772)
148 . S L=$L(DATA),X=$E(DATA,L-2,L) I X?3U,X'="CCC" S DATA=$E(DATA,1,L-3)_IOINHI_X_IOINORM
149 . S PROTC=$P(DATA,U,7)
150 . S $P(DATA,U,7)=$S(PROTP=PROTC:"...",1:"~hi~"_PROTC_"~hi~")
151 . W !,IEN772,?12,"-",?14
152 . F PNO=1:1:$L(DATA,U) D
153 . . S DATAP=$P(DATA,U,+PNO)
154 . . S DATAN=$P(DATA,U,+PNO+1)
155 . . I DATAP["~hi~" D
156 . . . S DATAP=$P(DATAP,"~hi~",2),LEN=$L(DATAP)+1
157 . . . S DATAP=IOINHI_DATAP_IOINORM
158 . . E S LEN=$L(DATAP)+1
159 . . S DATAP=DATAP_$S(DATAN]"":U,1:"")
160 . . W:(IOM-$X-LEN)'>0 !,?14
161 . . W DATAP
162 . I '(COUNT#4) W " ",IOINHI,"<",IOINORM R X:120 I X[U S STOP=1
163 . W !,$$REPEAT^XLFSTR($S($O(HL(IEN772)):"-",1:"="),IOM)
164 ;
165 ; Trailer...
166 S RES="C"
167 F S RES=$O(HL(RES)) Q:RES'?3U D
168 . S DATAR=HL(RES)
169 . W $$CJ^XLFSTR(RES_" - "_DATAR,IOM)
170 ;
171 Q
172 ;
173DATA(IEN772) ; Return what is displayed...
174 N DATA,IENPAR,RES
175 S IENPAR=+$G(^TMP($J,"HLUCMSTORE","X",+IEN772)) QUIT:'IENPAR "" ;->
176 S RES=$O(^TMP($J,"HLUCMSTORE","U",+IENPAR,+IEN772,"")) ; CCC, CXC, etc
177 S DATA=$G(^TMP($J,"HLUCMSTORE","U",+IENPAR,+IEN772,RES))_" <<>> "_$G(^TMP($J,"HLUCMSTORE","U",+IENPAR,+IEN772,RES,772))_" <<>> "_RES
178 I $TR(DATA," <>","")']"" S DATA=""
179 Q DATA
180 ;
181XTMPGBL(SHOW) ; Display XTMP data totals?
182 N ANS,API,BEG,COND,DATA,END,HOLD,NO,RUN,SVNO,TIME,XTMP
183 ;
184 S XTMP="HLUCM ",SHOW=+$G(SHOW),HOLD=0
185 QUIT:$O(^XTMP(XTMP))'?1"HLUCM "7N ;->
186 W !!,$$CJ^XLFSTR(" XTMP-stored Reports ",IOM),!,$$REPEAT^XLFSTR("=",IOM)
187 W !,"#",?4,"Run-time",?20,"API Call"
188 W !,$$REPEAT^XLFSTR("=",IOM)
189 F S XTMP=$O(^XTMP(XTMP)) Q:XTMP'?1"HLUCM "7N D
190 . S BEG=0
191 . F S BEG=$O(^XTMP(XTMP,"P",BEG)) Q:'BEG D
192 . . S END=0
193 . . F S END=$O(^XTMP(XTMP,"P",BEG,END)) Q:'END D
194 . . . S COND=""
195 . . . F S COND=$O(^XTMP(XTMP,"P",BEG,END,COND)) Q:COND']"" D
196 . . . . S DATA=$G(^XTMP(XTMP,"P",BEG,END,COND)) QUIT:DATA']"" ;->
197 . . . . S SVNO=+DATA,TIME=$P(DATA,U,2) QUIT:TIME']"" ;->
198 . . . . S DATA=$G(^XTMP(XTMP,"N",+SVNO)),API=$P(DATA,U,4)
199 . . . . S HOLD=HOLD+1
200 . . . . S HOLD(TIME,HOLD)=XTMP_U_SVNO_"~"_$E(TIME_" ",1,16)_$E("$$"_API_"("_BEG_","_END_",1,1,"""_COND_""",TOTALS,.ERR)",1,60)
201 . . . . S RUN(+SVNO)=XTMP
202 S TIME=0,HOLD=0
203 F S TIME=$O(HOLD(TIME)) Q:'TIME D
204 . S NO=0
205 . F S NO=$O(HOLD(TIME,NO)) Q:NO'>0 D
206 . . S DATA=HOLD(TIME,NO),XTMP=$P(DATA,U)
207 . . S SVNO=$P($P(DATA,"~"),U,2),DATA=$P(DATA,"~",2,999)
208 . . S HOLD=HOLD+1
209 . . S HOLD("N",HOLD)=XTMP_U_SVNO
210 . . W !,$E("#"_HOLD_" ",1,4),DATA
211 ;
212 QUIT:HOLD'>0 "" ;->
213 ;
214 W !!,"You may choose to print the totals report from stored XTMP data if you like."
215 W !,"If so, enter the number of the XTMP report from above now. (Otherwise,"
216 W !,"press RETURN.)"
217 ;
218 R !!,"Enter XTMP Report#: ",NO:999 Q:'$D(HOLD("N",+NO)) "" ;->
219 S XTMP=$P(HOLD("N",+NO),U),SVNO=$P(HOLD("N",+NO),U,2)
220 ;
221 Q $NA(^XTMP(XTMP,"D",SVNO))
222 ;
223EOR ; HLUCM004 - HL7/Capacity Mgt API ;3/13/03 09:37
Note: See TracBrowser for help on using the repository browser.