source: FOIAVistA/trunk/r/TEXT_INTEGRATION_UTILITIES-GMRP-TIU/TIU215R.m@ 1071

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

initial load of FOIAVistA 6/30/08 version

File size: 7.4 KB
Line 
1TIU215R ;VMP/RJT - Utililty to analyze problems cause by PATCH TIU*1.0*215 ; 7/25/2007
2 ;;1.0;TEXT INTEGRATION UTILITIES;**231**;Jun 20, 1997;Build 63
3 ; DBIA 4502 TO ACCESS SURGERY FILE
4 ; DBIA 5025 ACCESS ROUTINE SROANR
5 ; DBIA 5024 ACCESS ROUTINE SRONRP
6STRT ;
7 W !!
8EN NEW SRTN,TIUDA,TIUVAL,TIUCHKSU,SRVAL,SRCHKSUM,TIUDT,SRTNA,TIUEND,TIUACNT,TIUER,TIUFDEL,TIUADEL
9 NEW TIUA,TIUDAD,TIUDFN,TIUDONE,TIUNAM,TIUND,TIUX,TIUERR,SURFNAME,TIUFNAME,TIUPATH,SURFILEN,TIUFILEN
10 NEW TIUIO,SURIO,TIUCPF,TIUAIO,TIUANAME
11 S U="^",SURFILEN=1,TIUFILEN=1,TIUACNT=0
12 K ^TMP("TIUSNIR",$J),^TMP("SRNIR",$J)
13 S DIR("A")="Enter a begin date to start searching Surgery cases "
14 S DIR(0)="D^:DT:EX"
15 D ^DIR
16 I $D(DIRUT) K DIRUT Q
17 K DIR
18 S TIUDT=+Y
19 S DIR("A")="Enter date patch was backed out"
20 S DIR(0)="D^"_TIUDT_":DT:EX"
21 D ^DIR
22 K DIR
23 I $D(DIRUT) K DIRUT G STRT
24 S TIUEND=+Y
25 S DIR("A")="Enter the maximum number of cases per file"
26 S DIR(0)="N^5:50"
27 D ^DIR
28 K DIR
29 I $D(DIRUT) K DIRUT G STRT
30 S TIUCPF=Y
31PATH ;
32 K TIUFDEL
33 S DIR("A")="Enter the path of the output files"
34 S DIR(0)="F"
35 S DIR("?")=" "
36 S DIR("?",1)="Enter file path as USER$:[<DIRECTORY NAME>]"
37 D ^DIR
38 I $D(DIRUT) K DIRUT G STRT
39 S TIUPATH=Y
40 K DIR
41 S DIR("A")="Surgery output file (without file extension)"
42 S DIR(0)="F"
43 D ^DIR
44 K DIR
45 I $D(DIRUT) K DIRUT G PATH
46 S SURFNAME=Y
47 D OPENS I POP'=0 G PATH
48 S TIUFDEL(SURFNAME_SURFILEN_".TXT")=""
49 D CLOSE^%ZISH("SUR"_SURFILEN)
50 S DIR("A")="TIU output file (without file extension)"
51 S DIR(0)="F"
52 D ^DIR I $D(DIRUT) S TIUER=$$DEL^%ZISH(TIUPATH,$NA(TIUFDEL)) D ERR:'TIUER K DIR,DIRUT G PATH
53 S TIUFNAME=Y
54 K DIR
55 D OPENT I POP'=0 S TIUER=$$DEL^%ZISH(TIUPATH,$NA(TIUFDEL)) D ERR:'TIUER K DIR G PATH
56 S TIUFDEL(TIUFNAME_TIUFILEN_".TXT")=""
57 D CLOSE^%ZISH("TIU"_TIUFILEN)
58 S DIR("A")="TIU Addenda output file (without file extension)"
59 S DIR(0)="F"
60 D ^DIR I $D(DIRUT) S TIUER=$$DEL^%ZISH(TIUPATH,$NA(TIUFDEL)) D ERR:'TIUER K DIR,DIRUT G PATH
61 S TIUANAME=Y
62 K DIR
63 D OPENA I POP'=0 S TIUER=$$DEL^%ZISH(TIUPATH,$NA(TIUFDEL)) D ERR:'TIUER K DIR G PATH
64 S TIUADEL(TIUANAME_TIUFILEN_".TXT")=""
65 D CLOSE^%ZISH("TIUA"_TIUFILEN)
66 W !!!,"Processing...",!
67 S TIUIO=TIUPATH_TIUFNAME,SURIO=TIUPATH_SURFNAME,TIUAIO=TIUPATH_TIUANAME
68 K TIUFDEL
69EN1 ;
70 NEW TIUCNT,TIURECNT,SURRECNT,TIUCOUNT,SURDT,SURDONE S TIUCNT=0,TIURECNT=0,SURRECNT=0,TIUCOUNT=0
71 ; LOOP THROUGH SURGERY CASES WITHIN DATE RANGE
72 S (TIUDT,SURDT)=TIUDT-.0001
73 F S SURDT=$O(^SRF("AC",SURDT)) Q:'$L(SURDT) Q:SURDT\1>TIUEND D
74 . S TIUA=0 F S TIUA=$O(^SRF("AC",SURDT,TIUA)) Q:TIUA'>0 D
75 . . S SURDONE="" D CHK,CHK1
76 I TIUACNT=0 S TIUER=$$DEL^%ZISH(TIUPATH,$NA(TIUADEL))
77EN2 ;
78 W !,"There were "_TIUCOUNT_" records found to be discrepant.",!
79 Q
80 ; BUILD TMP GLOBALS AND COMPARE NIR CASES
81CHK S SRTN=TIUA
82 S TIUDA=$P($G(^SRF(SRTN,"TIU")),"^",2)
83 Q:+TIUDA'>0
84 ;DONT EVALUATE UNDICTATED
85 Q:$P($G(^TIU(8925,TIUDA,0)),U,5)=1
86 S TIUDFN=$P($G(^TIU(8925,TIUDA,0)),U,2)
87 K ^TMP("TIUSNIR",$J),^TMP("SRNIR",$J)
88 D RPT^SRONRPT(SRTN)
89 ;STRIP OUT SUBFILE DATA
90 S TIUX=0
91 F S TIUX=$O(^TIU(8925,+TIUDA,"TEXT",TIUX)) Q:TIUX="" D
92 . S ^TMP("TIUSNIR",$J,TIUDA,TIUX)=$G(^TIU(8925,+TIUDA,"TEXT",TIUX,0))
93 S TIUVAL="^TMP(""TIUSNIR"","_$J_","_+TIUDA_")"
94 S TIUCHKSU=$$CHKSUM^XUSESIG1(TIUVAL)
95 S SRVAL="^TMP(""SRNIR"","_$J_","_+SRTN_")"
96 S SRCHKSUM=$$CHKSUM^XUSESIG1(SRVAL)
97 I $G(TIUCHKSU)=$G(SRCHKSUM) Q
98 D NRPT
99 S TIURECNT=TIURECNT+1,SURRECNT=SURRECNT+1,TIUCOUNT=TIUCOUNT+1
100 K @TIUVAL,@SRVAL
101 Q
102CHK1 ; COMPARE ANESTHESIA REPORTS
103 S TIUDA=$P($G(^SRF(SRTN,"TIU")),"^",4)
104 Q:+TIUDA'>0
105 ;DONT EVALUATE UNDICTATED
106 Q:$P($G(^TIU(8925,TIUDA,0)),U,5)=1
107 K ^TMP("TIUSRANE",$J),^TMP("SRANE",$J)
108 D RPT^SROANR(SRTN)
109 ;STRIP OUT SUBFILE DATA
110 S TIUX=0
111 F S TIUX=$O(^TIU(8925,+TIUDA,"TEXT",TIUX)) Q:TIUX="" D
112 . S ^TMP("TIUSRANE",$J,TIUDA,TIUX)=$G(^TIU(8925,+TIUDA,"TEXT",TIUX,0))
113 S TIUVAL="^TMP(""TIUSRANE"","_$J_","_+TIUDA_")"
114 S TIUCHKSU=$$CHKSUM^XUSESIG1(TIUVAL)
115 S SRVAL="^TMP(""SRANE"","_$J_","_+SRTN_")"
116 S SRCHKSUM=$$CHKSUM^XUSESIG1(SRVAL)
117 I $G(TIUCHKSU)=$G(SRCHKSUM) Q
118 D ARPT
119 S TIURECNT=TIURECNT+1,SURRECNT=SURRECNT+1,TIUCOUNT=TIUCOUNT+1
120 K @TIUVAL,@SRVAL
121 Q
122NRPT D RPT^SRONRPT(SRTN) S DFN=$P(^SRF(SRTN,0),"^")
123 D SRHDR
124 D:SURRECNT=TIUCPF NEWSFILE
125 ;D CLOSE^%ZISH("TIU"_TIUFILEN)
126 D OPEN^%ZISH("SUR"_SURFILEN,TIUPATH,SURFNAME_SURFILEN_".TXT","A")
127 U SURIO_SURFILEN_".TXT"
128 W !!!!!!,SRHDR
129 W !,?4,"PRINTED BY TIU215R UTILITY***** NURSE INTRAOPERATIVE REPORT - CASE #"_SRTN
130 S SRI=0 F S SRI=$O(^TMP("SRNIR",$J,SRTN,SRI)) Q:'SRI D
131 .W !,^TMP("SRNIR",$J,SRTN,SRI),!
132 D SRHDR
133 D:TIURECNT=TIUCPF NEWTFILE
134 D CLOSE^%ZISH("SUR"_SURFILEN)
135 D OPEN^%ZISH("TIU"_TIUFILEN,TIUPATH,TIUFNAME_TIUFILEN_".TXT","A")
136 U TIUIO_TIUFILEN_".TXT"
137 I +TIUDA'>0 G NE
138 W !!!!!!,SRHDR
139 W !,?4,"PRINTED BY TIU215R UTILITY***** NURSE INTRAOPERATIVE REPORT - CASE #"_SRTN
140 S SRI=0 F S SRI=$O(^TMP("TIUSNIR",$J,TIUDA,SRI)) Q:'SRI D
141 .W !,^TMP("TIUSNIR",$J,TIUDA,SRI),!
142 S TIUDAD=$O(^TIU(8925,"DAD",TIUDA,0))
143 I +TIUDAD>0 D CLOSE^%ZISH("TIU"_TIUFILEN),ADDENDA
144NE D CLOSE^%ZISH("TIU"_TIUFILEN)
145 D KIL
146 Q
147ARPT ;
148 D SRHDR
149 D:SURRECNT=TIUCPF NEWSFILE
150 ;D CLOSE^%ZISH("TIU"_TIUFILEN)
151 D OPEN^%ZISH("SUR"_SURFILEN,TIUPATH,SURFNAME_SURFILEN_".TXT","A")
152 U SURIO_SURFILEN_".TXT"
153 W !,SRHDR
154 W !,?3,"PRINTED BY TIU215R UTILITY***** ANESTHESIA REPORT - CASE #"_SRTN
155 D RPT^SROANR(SRTN)
156 S DFN=$P(^SRF(SRTN,0),"^")
157 S SRI=0 F S SRI=$O(^TMP("SRANE",$J,SRTN,SRI)) Q:'SRI D
158 .W !,^TMP("SRANE",$J,SRTN,SRI),!
159 D SRHDR
160 D:TIURECNT=TIUCPF NEWTFILE
161 D CLOSE^%ZISH("SUR"_SURFILEN)
162 D OPEN^%ZISH("TIU"_TIUFILEN,TIUPATH,TIUFNAME_TIUFILEN_".TXT","A")
163 U TIUIO_TIUFILEN_".TXT"
164 I +TIUDA'>0 G AE
165 W !!!!!!,SRHDR
166 W !,?3,"PRINTED BY TIU215R UTILITY***** ANESTHESIA REPORT - CASE #"_SRTN
167 S SRI=0 F S SRI=$O(^TMP("TIUSRANE",$J,TIUDA,SRI)) Q:'SRI D
168 .W !,^TMP("TIUSRANE",$J,TIUDA,SRI),!
169 S TIUDAD=$O(^TIU(8925,"DAD",TIUDA,0))
170 I +TIUDAD>0 D CLOSE^%ZISH("TIU"_TIUFILEN),ADDENDA
171AE D CLOSE^%ZISH("TIU"_TIUFILEN)
172 D KIL
173 Q
174KIL K SRHDR,SRI,SRSDATE,VADM,VA,POP,VAINDT
175 Q
176ERR W !,"UNABLE TO CLEAN UP FILES ON ^ ABORT" Q
177SRHDR NEW DFN,Y
178 S DFN=$P(^SRF(SRTN,0),"^") D DEM^VADPT
179 S Y=$E($P(^SRF(SRTN,0),"^",9),1,7) D D^DIQ S SRSDATE=Y
180 S SRHDR=" "_VADM(1)_" ("_VA("PID")_") Case #"_SRTN_" - "_SRSDATE
181 Q
182ADDENDA ;
183 N TIUI,TIUDAD S TIUI=0,TIUDAD=0,TIUACNT=1
184 D OPEN^%ZISH("TIUA"_TIUFILEN,TIUPATH,TIUANAME_TIUFILEN_".TXT","A")
185 U TIUAIO_TIUFILEN_".TXT"
186 W !!!!,"**************************************************************************",!,SRHDR
187 W !,?4,"PRINTED BY TIU215F UTILITY***** TIU ADDENDA - CASE #"_SRTN,!,"**************************************************************************",!
188 ; Loop through all addenda for that note
189 F S TIUDAD=$O(^TIU(8925,"DAD",TIUDA,TIUDAD)) Q:TIUDAD'>0 D
190 . W !!,?2,"ADDENDUM #"_TIUDAD,!,?2,"-----------------------------------------" S TIUI=0
191 . ; Loop through entire addendum
192 . F S TIUI=$O(^TIU(8925,TIUDAD,"TEXT",TIUI)) Q:TIUI'>0 D
193 . . W !,$G(^TIU(8925,TIUDAD,"TEXT",TIUI,0))
194 D CLOSE^%ZISH("TIUA"_TIUFILEN)
195 Q
196NEWSFILE ;
197 D CLOSE^%ZISH("SUR"_SURFILEN) S SURFILEN=SURFILEN+1,SURRECNT=0
198 D OPEN^%ZISH("SUR"_SURFILEN,TIUPATH,SURFNAME_SURFILEN_".TXT","W")
199 Q
200NEWTFILE ;
201 D CLOSE^%ZISH("TIU"_TIUFILEN) S TIUFILEN=TIUFILEN+1,TIURECNT=0
202 D OPEN^%ZISH("TIU"_TIUFILEN,TIUPATH,TIUFNAME_TIUFILEN_".TXT","W")
203 Q
204OPENS ;
205 D OPEN^%ZISH("SUR"_SURFILEN,TIUPATH,SURFNAME_SURFILEN_".TXT","W")
206 I POP'=0 W !,"Error opening Surgery output file.",!
207 Q
208OPENT ;
209 D OPEN^%ZISH("TIU"_TIUFILEN,TIUPATH,TIUFNAME_TIUFILEN_".TXT","W")
210 I POP'=0 W !,"Error opening TIU output file.",!
211 Q
212OPENA ;
213 D OPEN^%ZISH("TIUA"_TIUFILEN,TIUPATH,TIUANAME_TIUFILEN_".TXT","W")
214 I POP'=0 W !,"Error opening TIU Addendum output file.",!
215 Q
Note: See TracBrowser for help on using the repository browser.