source: WorldVistAEHR/trunk/r/TEXT_INTEGRATION_UTILITIES-GMRP-TIU/TIU215F.m@ 789

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

initial load of WorldVistAEHR
File size: 6.2 KB
RevLine 
[613]1TIU215F ;VMP/ELR - 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 ;COMPARE CHECKSUMS BETWEEN TIU AND SURGERY TO TRY AND FIND RECORDS WHERE THE ADDENDUM WAS NOT FILED IN TIU
4 ; DBIA 4502 TO ACCESS SURGERY FILE
5 ; DBIA 5025 ACCESS ROUTINE SROANR
6 ; DBIA 5024 ACCESS ROUTINE SRONRPT
7ENV ;DUMMY ENVIRONMENT CHECK TO GET ROUTINE LOADED FOR USE IN INSTALL QUESTIONS
8 Q
9STRT ;
10 Q
11 W !!!
12 W !,"1. ANALYZE POTENTIAL SURGERY/TIU PROBLEMS"
13 W !,"2. VIEW SINGLE SURGERY CASE USING CASE #"
14 W !,"3, SEND OUTPUT TO TEXT FILES"
15 S DIR("A")="SELECT 1 OR 2 OR 3"
16 S DIR(0)=("N^1:3")
17 D ^DIR
18 I $D(DIRUT) K DIRUT Q
19 K DIR
20 G EN:Y=1
21 G ASK:Y=2
22 D ^TIU215R G STRT
23 Q
24EN NEW SRTN,TIUDA,TIUVAL,TIUCHKSU,SRVAL,SRCHKSUM,TIUDT,SRTNA,TIUEND
25 NEW TIUA,TIUDAD,TIUDFN,TIUDONE,TIUNAM,TIUND,TIUX,TIUERR
26 S U="^"
27 K ^TMP("TIUSNIR",$J),^TMP("SRNIR",$J)
28 S DIR("A")="Enter a date equal or prior to the date patch was installed"
29 S DIR(0)="D^:DT:EX"
30 D ^DIR
31 K DIR
32 I $D(DIRUT) K DIRUT G STRT
33 S TIUDT=+Y
34 S DIR("A")="Enter date patch was backed out"
35 S DIR(0)="D^"_TIUDT_":DT:EX"
36 D ^DIR
37 K DIR
38 I $D(DIRUT) K DIRUT G STRT
39 S TIUEND=+Y
40EN1 ;
41 NEW TIUCNT S TIUCNT=0
42 D HD
43 G EN2:$G(TIUDT)'>0
44 S TIUDT=TIUDT-.0001
45 F S TIUDT=$O(^SRF("AC",TIUDT)) Q:'$L(TIUDT) Q:TIUDT\1>TIUEND D
46 . S TIUA=0 F S TIUA=$O(^SRF("AC",TIUDT,TIUA)) Q:TIUA'>0 D
47 . . S TIUDONE="" D CHK,CHK1
48 I $D(XPDQUES),$G(XPDQUES("POS1"))=1 D BULL
49EN2 I $D(XPDQUES),$G(XPDQUES("POS1"))'=1 D MSG H .5
50 I $G(TIUERR)=1 D BULL1("It looks like you did not back out patch TIU*1.0*215")
51 I $D(XPDQUES) Q
52 G STRT
53CHK S SRTN=TIUA
54 S TIUDA=$P($G(^SRF(SRTN,"TIU")),"^",2)
55 Q:+TIUDA'>0
56 ;DONT EVALUATE UNDICTATED
57 Q:$P($G(^TIU(8925,TIUDA,0)),U,5)=1
58 S TIUDFN=$P($G(^TIU(8925,TIUDA,0)),U,2)
59 K ^TMP("TIUSNIR",$J),^TMP("SRNIR",$J)
60 D RPT^SRONRPT(SRTN)
61 ;STRIP OUT SUBFILE DATA
62 S TIUX=0
63 F S TIUX=$O(^TIU(8925,+TIUDA,"TEXT",TIUX)) Q:TIUX="" D
64 . S ^TMP("TIUSNIR",$J,TIUDA,TIUX)=$G(^TIU(8925,+TIUDA,"TEXT",TIUX,0))
65 S TIUVAL="^TMP(""TIUSNIR"","_$J_","_+TIUDA_")"
66 S TIUCHKSU=$$CHKSUM^XUSESIG1(TIUVAL)
67 S SRVAL="^TMP(""SRNIR"","_$J_","_+SRTN_")"
68 S SRCHKSUM=$$CHKSUM^XUSESIG1(SRVAL)
69 I $G(TIUCHKSU)=$G(SRCHKSUM) Q
70 D SETLN("NIR")
71 K @TIUVAL,@SRVAL
72 Q
73CHK1 ;
74 S TIUDA=$P($G(^SRF(SRTN,"TIU")),"^",4)
75 Q:+TIUDA'>0
76 ;DONT EVALUATE UNDICTATED
77 Q:$P($G(^TIU(8925,TIUDA,0)),U,5)=1
78 K ^TMP("TIUSNIR",$J),^TMP("SRANE",$J)
79 D RPT^SROANR(SRTN)
80 ;STRIP OUT SUBFILE DATA
81 S TIUX=0
82 F S TIUX=$O(^TIU(8925,+TIUDA,"TEXT",TIUX)) Q:TIUX="" D
83 . S ^TMP("TIUSNIR",$J,TIUDA,TIUX)=$G(^TIU(8925,+TIUDA,"TEXT",TIUX,0))
84 S TIUVAL="^TMP(""TIUSNIR"","_$J_","_+TIUDA_")"
85 S TIUCHKSU=$$CHKSUM^XUSESIG1(TIUVAL)
86 S SRVAL="^TMP(""SRANE"","_$J_","_+SRTN_")"
87 S SRCHKSUM=$$CHKSUM^XUSESIG1(SRVAL)
88 I $G(TIUCHKSU)=$G(SRCHKSUM) Q
89 D SETLN("ANES")
90 K @TIUVAL,@SRVAL
91 Q
92NAM NEW DFN
93 Q:$G(TIUDONE)=1
94 S TIUNAM=$P($G(^TIU(8925,TIUDA,0)),U,2)
95 S DFN=TIUNAM D DEM^VADPT
96 I $D(XPDQUES) S TIUNAM=$E(VADM(1))_VA("BID")
97 E S TIUNAM=$E(VADM(1),1,20)
98 S Y=$P($G(^TIU(8925,TIUDA,13)),U,1)
99 D DD^%DT S TIUND=Y
100 S TIUDONE=1
101 Q
102ASK S DIR(0)="P^130"
103 S DIR("A")="ENTER THE CASE NUMBER AS `NNNNNN"
104 D ^DIR
105 I $D(DIRUT) K DIRUT G STRT
106 S SRTN=+Y
107 D ^%ZIS G ASK:$G(POP)=1
108 N TIUERR S TIUERR=""
109 D SRHDR
110 U IO
111 W !,SRHDR
112 W !,?4,"PRINTED BY TIU215F UTILITY***** NURSE INTRAOPERATIVE REPORT - CASE #"_SRTN
113 ;D CSUM I $G(TIUERR)=1 W !!,"******It looks like you did not back out patch TIU*1.0*215*****",!
114RPT D RPT^SRONRPT(SRTN) S DFN=$P(^SRF(SRTN,0),"^")
115 S SRI=0 F S SRI=$O(^TMP("SRNIR",$J,SRTN,SRI)) Q:'SRI D
116 .W !,^TMP("SRNIR",$J,SRTN,SRI),!
117 I $Y'=0 W @IOF
118 G RPTX:$P($G(^SRF(SRTN,"TIU")),"^",4)'>0
119 S TIUDA=$P($G(^SRF(SRTN,"TIU")),"^",4) G RPTX:$P($G(^TIU(8925,TIUDA,0)),U,5)=1
120 W !,SRHDR
121 W !,?3,"PRINTED BY TIU215F UTILITY***** ANESTHESIA REPORT - CASE #"_SRTN
122 I $G(TIUERR)=1 W !!,"******It looks like you did not back out patch TIU*1.0*215*****",!
123 D RPT^SROANR(SRTN)
124 S DFN=$P(^SRF(SRTN,0),"^")
125 S SRI=0 F S SRI=$O(^TMP("SRANE",$J,SRTN,SRI)) Q:'SRI D
126 .W !,^TMP("SRANE",$J,SRTN,SRI),!
127RPTX D ^%ZISC
128 K SRAGE,SRDIV,SRHDR,SRI,SRLOC,SRPRINT,SRSDATE,TIUERR,VADM,VA,POP,SREST,SRP,SRPOS,SRTN,VAINDT
129 G ASK
130SRHDR S DFN=$P(^SRF(SRTN,0),"^") D DEM^VADPT
131 S Y=$E($P(^SRF(SRTN,0),"^",9),1,7) D D^DIQ S SRSDATE=Y
132 S SRHDR=" "_VADM(1)_" ("_VA("PID")_") Case #"_SRTN_" - "_SRSDATE
133 Q
134HD NEW HD1,HD2,HD3,HD4,HD5,TIUI,Y
135 S HD1="DIFFERENCE IN CHECKSUMS BETWEEN SURGERY & TIU "
136 S HD2="RUN DATE " D NOW^%DTC S Y=% D DD^%DT S HD2=HD2_Y K %
137 S HD3="START DATE " S Y=TIUDT D DD^%DT S HD3=HD3_Y
138 S HD4="END DATE " S Y=TIUEND D DD^%DT S HD4=HD4_Y
139 S HD5="TYPE CASE #",$E(HD5,37)=" ",HD5=HD5_"TIU NOTE DATE",$E(HD5,57)=" ",HD5=HD5_"PATIENT "
140 I '$D(XPDQUES) W !,HD1,!,HD2,!,HD3,!,HD4,!,HD5 Q
141 F TIUI=HD1,HD2,HD3,HD4,HD5 S TIUCNT=TIUCNT+1,^TMP("TIU215F",$J,TIUCNT)=TIUI
142 Q
143SETLN(A) ;
144 NEW TIULN
145 S TIUCNT=TIUCNT+1
146 S TIULN=A,$E(TIULN,5)=" "
147 S TIULN=TIULN_" "_SRTN
148 S TIUDAD=0,TIUDAD=$O(^TIU(8925,"DAD",TIUDA,TIUDAD))
149 I +TIUDAD>0 S TIULN=TIULN_" TIU REPORT HAS ADDENDUM"
150 D NAM
151 S $E(TIULN,37)=" ",TIULN=TIULN_TIUND,$E(TIULN,57)=" ",TIULN=TIULN_TIUNAM
152 I '$D(XPDQUES) W !,TIULN Q
153 S ^TMP("TIU215F",$J,TIUCNT)=TIULN
154 Q
155INS ;ENTRY POINT FOR INSTALL
156 S TIUDT=$G(XPDQUES("POS2"))
157 S TIUEND=$G(XPDQUES("POS3"))
158 K ^TMP("TIU215F",$J)
159 ;D CSUM
160 G EN1
161BULL ; Bulletin of analysis
162 N XMSUB,XMTEXT,XMY,XMDUZ,DIFROM,XMZ,XMMG
163 I $G(TIUCNT)'>5 S ^TMP("TIU215F",$J,6)="No discrepencies found in date range"
164 S XMSUB="ANALYSIS OF POTENTIAL PROBLEMS CAUSED BY PATCH TIU*1.0*215 " K XMY
165 S XMTEXT="^TMP(""TIU215F"",$J,"
166 S XMY($S(DUZ:DUZ,1:.5))=""
167 S XMDUZ=.5 D NOW^%DTC
168 D ^XMD
169 K ^TMP("TIU215F",$J),XMY,XMTEXT,XMSUB
170 Q
171BULL1(A) ; Bulletin
172 S TIUCNT=TIUCNT+1
173 N XMSUB,XMTEXT,XMY,XMDUZ,DIFROM,XMZ,XMMG
174 S XMSUB="ANALYSIS OF POTENTIAL PROBLEMS CAUSED BY PATCH TIU*1.0*215" K XMY
175 S XMTEXT="^TMP(""TIU215F"",$J,"
176 S ^TMP("TIU215F",$J,TIUCNT)=A
177 S XMY($S(DUZ:DUZ,1:.5))=""
178 S XMDUZ=.5 D NOW^%DTC
179 D ^XMD
180 K ^TMP("TIU215F",$J),XMY,XMTEXT,XMSUB
181 Q
182POS2 I $G(XPDQUES("POS1"))'=1 K DIR Q
183 Q
184POS3 I $G(XPDQUES("POS1"))'=1 K DIR Q
185 S DIR(0)="D^"_$G(XPDQUES("POS2"))_":DT:EX"
186 Q
187CSUM Q I $D(^%ZOSF("RSUM1")) N X,Y S TIUERR="",X="TIULP" X ^%ZOSF("RSUM1") I Y'="47310116" S TIUERR=1
188 Q
189MSG NEW TIUMSG S TIUMSG="No analysis performed, you entered patch not loaded. "
190 I +$O(^XPD(9.7,"B","TIU*1.0*215",0)) S TIUMSG=TIUMSG_"But it is in your install file"
191 D BULL1(TIUMSG)
192 Q
Note: See TracBrowser for help on using the repository browser.