source: FOIAVistA/tag/r/HEALTH_LEVEL_SEVEN-HL/HLCSRPT4.m@ 636

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

initial load of FOIAVistA 6/30/08 version
File size: 7.7 KB
Line 
1HLCSRPT4 ;OIFO-O/LJA - Error Listing code ;3/18/02 10:19
2 ;;1.6;HEALTH LEVEL SEVEN;**85**;Oct 13, 1995
3 ;
4 ; Patch HL*1.6*85 created a significant amount of code; enough
5 ; that this routine had to be created to hold it.
6 ;
7LOADERR ; Find latest NUMERR statuses in ERRDTB->ERRDTE date range. ;HL*1.6*85
8 ;ERRDTB,ERRDTE,HLCSER,HLCSTER1,NUMERR -- req
9 ;
10 N CT,ERR,ERR4,IEN,TIME
11 ;
12 KILL ^TMP("HLERR",$J),^TMP("ERRLST",$J)
13 ;
14 S HLERR=3.9,CT=0
15 F S HLERR=$O(^HLMA("AG",HLERR)) QUIT:HLERR'>0!(HLERR>7) D
16 . S IEN773=0
17 . F S IEN773=$O(^HLMA("AG",HLERR,IEN773)) Q:IEN773'>0 D
18 . . S ERR4=$P($G(^HLMA(+IEN773,"P")),U,4) QUIT:ERR4'>0 ;->
19 . . D CHKERR(ERR4,IEN773,ERRDTB,ERRDTE)
20 . . S CT=CT+1 W:'(CT#1000) "."
21 ;
22 S ERR=0
23 F S ERR=$O(^TMP("HLERR",$J,ERR)) Q:ERR'>0 D
24 . S TIME=0
25 . F S TIME=$O(^TMP("HLERR",$J,ERR,TIME)) Q:TIME'>0 D
26 . . S IEN=0
27 . . F S IEN=$O(^TMP("HLERR",$J,ERR,TIME,IEN)) Q:IEN'>0 D
28 . . . S ^TMP("ERRLST",$J,+ERR,+IEN)=""
29 ;
30 KILL ^TMP("HLERR",$J)
31 ;
32 QUIT
33 ;
34CHKERR(ERR4,IEN773,DTB,DTE) ; Should this entry be included? ;HL*1.6*85
35 ;NUMERR -- req
36 ;
37 N ERRNO,OLD773,OLDPDT,PROCDT
38 ;
39 ; Processing date/time check...
40 S PROCDT=$$PROCDT(IEN773) QUIT:PROCDT'>0 ;->
41 I PROCDT<DTB!(PROCDT>DTE) QUIT ;->
42 ; OK. Date check passes. But, is it among NUMERR latest?
43 ;
44 ; How many errors recorded for error status?
45 S ERRNO=$G(^TMP("HLERR",$J,ERR4))
46 ;
47 ; Number of errors recorded less than # maximum per status...
48 I ERRNO<NUMERR D RECERR(ERR4,IEN773) QUIT ;->
49 ;
50 ; Find oldest entry's process date/time & last 773 IEN...
51 S OLDPDT=$O(^TMP("HLERR",$J,ERR4,0)) QUIT:OLDPDT'>0 ;->
52 S OLD773=$O(^TMP("HLERR",$J,ERR4,+OLDPDT,0)) QUIT:OLD773'>0 ;->
53 ;
54 ; Now see if "this" error is newer...
55 QUIT:PROCDT<OLDPDT ;->
56 I PROCDT=OLDPDT,IEN773<OLD773 QUIT ;->
57 ;
58 ; Max number errors reached, but this error is newer than newest...
59 ;
60 ; Zilch oldest entry, then record "this" error...
61 D KILLERR(ERR4,OLDPDT,OLD773)
62 D RECERR(ERR4,IEN773)
63 ;
64 QUIT
65 ;
66KILLERR(ERR4,OLDPDT,OLD773) ; Remove entry and adjust counts... ;HL*1.6*85
67 N NUM
68 ;
69 KILL ^TMP("HLERR",$J,ERR4,OLDPDT,OLD773)
70 ;
71 I $O(^TMP("HLERR",$J,ERR4,OLDPDT,0))'>0 D
72 . KILL ^TMP("HLERR",$J,ERR4,OLDPDT)
73 I $O(^TMP("HLERR",$J,ERR4,OLDPDT,0))>0 D
74 . S NUM=$G(^TMP("HLERR",$J,ERR4,OLDPDT))-1,NUM=$S(NUM'<0:+NUM,1:0)
75 . S ^TMP("HLERR",$J,ERR4,OLDPDT)=NUM
76 ;
77 I $O(^TMP("HLERR",$J,ERR4,0))'>0 D
78 . KILL ^TMP("HLERR",$J,ERR4)
79 I $O(^TMP("HLERR",$J,ERR4,0))>0 D
80 . S NUM=$G(^TMP("HLERR",$J,ERR4))-1,NUM=$S(NUM'<0:+NUM,1:0)
81 . S ^TMP("HLERR",$J,ERR4)=NUM
82 ;
83 I $O(^TMP("HLERR",$J,0))'>0 D
84 . KILL ^TMP("HLERR",$J)
85 I $O(^TMP("HLERR",$J,0))>0 D
86 . S NUM=$G(^TMP("HLERR",$J))-1,NUM=$S(NUM'<0:+NUM,1:0)
87 . S ^TMP("HLERR",$J)=NUM
88 ;
89 QUIT
90 ;
91RECERR(ERR4,IEN773) ; Store error in ^TMP("HLERR",$J,STATUS,IEN773) ;HL*1.6*85
92 S ^TMP("HLERR",$J,ERR4)=$G(^TMP("HLERR",$J,ERR4))+1
93 S ^TMP("HLERR",$J,ERR4,PROCDT)=$G(^TMP("HLERR",$J,ERR4,PROCDT))+1
94 S ^TMP("HLERR",$J,ERR4,PROCDT,IEN773)=""
95 QUIT
96 ;
97SETUP() ; Setup "limit" variables... ;HL*1.6*85
98 S TYPEINFO=$$TYPEINFO QUIT:TYPEINFO']"" "" ;->
99 ;
100 S (ERRDTB,ERRDTE,NUMERR)=""
101 W !!," If you answer NO below, you will be allowed to specify the number of"
102 W !," errors to be included in the report."
103 W !
104 S NUMERR=$$YN("Print all errors","No") QUIT:NUMERR']"" "" ;->
105 S NUMERR=$S(NUMERR=1:9999999,1:$$NUMERR) QUIT:NUMERR'>0 "" ;->
106 I NUMERR=9999999 D
107 . W !!," All errors in the date range you specify next will be included"
108 . W !," in the report."
109 I NUMERR'=9999999 D
110 . W !!," The newest ",NUMERR," errors, for every error status, in the date range you"
111 . W !," specify next will be included in the report."
112 W !!,"The first entry at your site is from ",$$FMTE^XLFDT($O(^HL(772,"B",2840000))),"."
113 W !
114S1 S ERRDTB=$$DATE("Enter START DATE/TIME",,$$FMADD^XLFDT($$DT^XLFDT,-90)) QUIT:ERRDTB'>0 "" ;->
115 W !
116 S ERRDTE=$$DATE("Enter END DATE/TIME",ERRDTB,"NOW") QUIT:ERRDTE'>0 "" ;->
117 I ERRDTB=ERRDTE D G S1 ;->
118 . W !!,"You cannot enter the same values for the beginning and ending times!"
119 . W !
120 QUIT 1
121 ;
122NUMERR() ; How many errors, maximum, does user want to see ;HL*1.6*85
123 ; HLCSER -- req
124 N DIR,DIRUT,DTOUT,DUOUT,X,Y
125 W !!,"Enter the maximum number errors to report for every error status."
126 W !
127 S DIR(0)="N",DIR("A")="Enter maximum number errors/status"
128 S DIR("B")=999
129 S DIR("?",1)="If you enter '1000' for the maximum number errors/status..."
130 S DIR("?",2)=""
131 I HLCSER="ALL" D
132 . S DIR("?",3)="... The most recent 1000 errors for every error type will be included in the"
133 . S DIR("?",4)="... report. If two different error types exist, and each error type has"
134 . S DIR("?",5)="... more than 1000 entries, then 2000 errors will be reported."
135 . S DIR("?")="... (I.e., 1000 errors per error type.)"
136 I HLCSER'="ALL" D
137 . S DIR("?",3)="... The most recent 1000 errors for the error type you just selected"
138 . S DIR("?")="... will be included in the report."
139 D ^DIR
140 QUIT $S(Y>0:+Y,1:"")
141 ;
142DATE(PMT,BDT,PDT) ; Entry of date for looping ;HL*1.6*85
143 N DIR,DIRUT,DTOUT,DUOUT,X,Y
144 S BDT=$S($G(BDT)?7N.E:BDT,1:"")
145 S DIR(0)="DA^"_$G(BDT)_"::ET"
146 I $G(BDT)>0 D
147 . N TXT
148 . S TXT="Enter a date/time after "_$$FMTE^XLFDT(BDT)_"..."
149 . S DIR("?")=TXT
150 S DIR("A")=PMT_": "
151 I $G(PDT)?7N.E S DIR("B")=$P($$FMTE^XLFDT(PDT),":",1,2)
152 I $G(PDT)="NOW" S DIR("B")="NOW"
153 D ^DIR
154 I Y?7N.E,$G(PMT)="NOW",$G(PDT)="NOW" QUIT 9999999.24 ;->
155 QUIT $S(Y>0:+Y,1:"")
156 ;
157YN(PMT,DEF,FF) ; Generic YES/NO DIR call... ;HL*1.6*85
158 N DIR,DIRUT,DTOUT,DUOUT,X,Y
159 F X=1:1:$G(FF) W !
160 S DIR(0)="Y",DIR("A")=PMT
161 S:$G(DEF)]"" DIR("B")=DEF
162 D ^DIR
163 QUIT:$D(DIRUT)!($D(DTOUT))!($D(DUOUT)) "" ;->
164 QUIT $S(Y=1:1,1:0)
165 ;
166TMPLOG ; Reset ^TMP("TMPLOG") data created in ERRRPT to ^TMP("TLOG") format
167 ; expected by the browser. (See DISPLAY^HLCSRPT)
168 ; [This subroutine created by HL*1.6*85.]
169 N HLCSLN,PROCDT,IEN773
170 S HLCSLN=0,PROCDT="zzzzz"
171 F S PROCDT=$O(^TMP("TMPLOG",$J,PROCDT),-1) Q:PROCDT']"" D
172 . S IEN773=":"
173 . F S IEN773=$O(^TMP("TMPLOG",$J,PROCDT,IEN773),-1) Q:IEN773'>0 D
174 . . S HLCSLN=HLCSLN+1
175 . . S ^TMP("TLOG",$J,+HLCSLN)=$G(^TMP("TMPLOG",$J,PROCDT,IEN773))
176 KILL ^TMP("TMPLOG",$J)
177 QUIT
178 ;
179OKDATE(IEN773,DTBEG,DTEND) ; Does 773 processing time fall in date range? ;HL*1.6*85
180 N PROCDT
181 ;
182 ; Check what's passed in...
183 QUIT:'$D(^HLMA(+IEN773,0)) "" ;->
184 QUIT:$G(DTBEG)'?7N.E "" ;->
185 QUIT:$G(DTEND)'?7N.E "" ;->
186 ;
187 ; Get processing date/time...
188 S PROCDT=$$PROCDT(IEN773) QUIT:PROCDT'?7N.E "" ;->
189 ;
190 ; Compare dates...
191 I PROCDT=DTBEG!(PROCDT=DTEND) QUIT 1 ;->
192 QUIT:PROCDT<DTBEG "" ;->
193 QUIT:PROCDT>DTEND "" ;->
194 ;
195 QUIT 1
196 ;
197PROCDT(IEN773) ; Return 773'S processing date (1st), or if not available
198 ; return the 772 creation date/time. ;HL*1.6*85
199 N PROCDT
200 S PROCDT=$P($G(^HLMA(+IEN773,"S")),U) QUIT:PROCDT?7N.E PROCDT ;->
201 QUIT $P($G(^HL(772,+$G(^HLMA(+IEN773,0)),0)),U)
202 ;
203DTORTM(DTB,DTE,PDT) ; Show date or time?
204 QUIT $S($E(DTB,1,7)=$E(DTE,1,7):$$TM(PDT),1:$$DT(PDT))
205 ;
206TM(PDT) ; Show the 5 character hh:mm time
207 QUIT $E($P($$FMTE^XLFDT(+PDT),"@",2),1,5)
208 ;
209DT(PDT) ; Show the 8 character mm/dd/yy date
210 QUIT $E(PDT,4,5)_"/"_$E(PDT,6,7)_"/"_$E(PDT,2,3)
211 ;
212TYPEINFO() ; Display error type or application information?
213 N DIR,DIRUT,DTOUT,DUOUT,X,Y
214 W !!,"Select the report view now. There are two report views. Both list the "
215 W !,"internal entry number from the HL7 Message Administration file (#773) entry,"
216 W !,"message ID, processing date or time, and logical link. The two report views"
217 W !,"differ in the remainder of the information displayed on the report. "
218 S DIR(0)="S^1:Display message, event, & application data;2:Display error type"
219 S DIR("A")="Select data to display",DIR("B")=1
220 S DIR("?",1)="Select the data to be displayed in the last few columns of the report after"
221 S DIR("?")="the IEN, message ID, processing date or time, and logical link."
222 D ^DIR
223 QUIT $S(Y>0:+Y,1:"")
224 ;
225EOR ;HLCSRPT4 - Error Listing code ;3/18/02 10:19
Note: See TracBrowser for help on using the repository browser.