source: WorldVistAEHR/trunk/r/IMAGING-MAG-ZMAG/MAGCRPT.m@ 1080

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

initial load of WorldVistAEHR
File size: 9.5 KB
RevLine 
[613]1MAGCRPT ;WOIFO/EdM ; Report on inconsistencies ; [ 11/01/2001 11:27 ]
2 ;;3.0;IMAGING;;Mar 01, 2002
3 ;; +---------------------------------------------------------------+
4 ;; | Property of the US Government. |
5 ;; | No permission to copy or redistribute this software is given. |
6 ;; | Use of unreleased versions of this software requires the user |
7 ;; | to execute a written test agreement with the VistA Imaging |
8 ;; | Development Office of the Department of Veterans Affairs, |
9 ;; | telephone (301) 734-0100. |
10 ;; | |
11 ;; | The Food and Drug Administration classifies this software as |
12 ;; | a medical device. As such, it may not be changed in any way. |
13 ;; | Modifications to this software may result in an adulterated |
14 ;; | medical device under 21CFR820, the use of which is considered |
15 ;; | to be a violation of US Federal Statutes. |
16 ;; +---------------------------------------------------------------+
17 ;;
18 Q
19 ;
20RPT(TYPE) ; This entry is called from the VistA Menu Option handler
21 ; The value of TYPE is equal to either
22 ; "QA" -- report for Quality Assurance (option MAG_IC_RPT_QA)
23 ; "CO" -- report for Central Office (option MAG_IC_RPT_CO)
24 ;
25 N OK,POP,X,Y,STOP,TODAY,STATUS,NUMBER,ERRTYPE,I,II,VA,VADM
26 S NUMBER=$O(^XTMP("MAGCHK",""))
27 I +NUMBER,$P(^XTMP("MAGCHK",NUMBER,0),"^",1)'?.N1".".N S NUMBER=0
28 ; Previous scans had the 1st piece as the scan status instead of the purge date for XTMP
29 S OUT=0
30 I +NUMBER D
31 . S STATUS=$P($G(^XTMP("MAGCHK",NUMBER,0)),"^",4)
32 . D NOW^%DTC S TODAY=%
33 . S START=$P($G(^XTMP("MAGCHK",NUMBER,0)),"^",5)
34 . S STOP=$P($G(^XTMP("MAGCHK",NUMBER,0)),"^",6)
35 I +NUMBER I STATUS'="COMPLETE" D
36 . S Y=$P(^XTMP("MAGCHK",NUMBER,0),"^",5) X ^DD("DD")
37 . N DIR
38 . S OK=1
39 . W !!,"Scanning appears to be active. It was started on: "_Y
40 . S DIR(0)="Y",DIR("B")="Y"
41 . S DIR("A")="Do you want to start it again?"
42 . D ^DIR S:'Y OK=0
43 . I 'OK W !,"Note: Report will be partial and not the complete report."
44 . I OK S NUMBER=0
45 . I Y["^" S OUT=1
46 . Q
47 I +OUT Q
48 ;check to see if scan is over 2 weeks old
49 I +NUMBER I STATUS="COMPLETE" S X1=TODAY,X2=STOP D ^%DTC I X>14 D
50 . S DAYS=+X
51 . N DIR
52 . S OK=1
53 . S DIR(0)="Y",DIR("B")="Y"
54 . S DIR("A",1)="The database scanner has not run in "_+X_" days"
55 . S DIR("A")="Do you want to start a new scan? "
56 . D ^DIR S:'Y OK=0
57 . I 'OK W !,"Note: You will get an old report."
58 . I OK S NUMBER=0
59 . I Y["^" S OUT=1
60 . Q
61 I +OUT Q
62 S OK=0 F D Q:POP>0 Q:OK
63 . D ^%ZIS Q:POP>0
64 . I IOM<132 W !!,"Report is formatted for 132 columns",!,"Try again" Q
65 . S OK=1
66 . I $E(IOST,1,1)'="P" D Q:'OK
67 . . N DIR
68 . . S DIR(0)="Y"
69 . . S DIR("A")="This is not a printer. Is this OK",DIR("B")="YES"
70 . . D ^DIR S:'Y OK=0
71 . . Q
72 . I $D(IO("Q")) D Q
73 . . S ZTRTN="WORK^MAGICRPT"
74 . . S ZTIO=ION_";132"
75 . . S ZTDESC="Imaging Integrity Check Report"
76 . . S ZTSAVE("TYPE")=TYPE
77 . . D ^%ZTLOAD,HOME^%ZIS
78 . . I '$D(ZTSK) S OK=0 W !!,$C(7),"Request canceled.",! Q
79 . . W !!,"Request queued." S OK=-1
80 . . Q
81 . Q
82 Q:OK<1 Q:POP>0
83 W !!,"Report being produced on ",IOST,!!
84 U IO D WORK D ^%ZISC,HOME^%ZIS
85 Q
86 ;
87WORK N D0,ERR,H1,H2,I,LIN,N,PAG,PT,SQI,X
88 K ^TMP("MAGMAIL",$J)
89 S ^TMP("MAGMAIL",$J,1,0)="Image^DFN-1^Name-1^SS4-1^SS4-2^DFN-2^DFN-2^Package^D0/D1^Message"
90 D:'NUMBER RPT^MAGGSQI(.SQI,1E11) S NUMBER=$O(^XTMP("MAGCHK",""))
91 S H1=$P(^XTMP("MAGCHK",NUMBER,0),"^",5) S X=H1 D H^%DTC S H1=%H_","_%T
92 S H2=$P(^XTMP("MAGCHK",NUMBER,0),"^",6) S X=H2 D H^%DTC S H2=%H_","_%T
93 S PAG=0
94 S PT(3.9)="^XMB(3.9,PD0|MailMan||2|^XMB(3.9,PD0,2005,"
95 S PT(63)="^LR(PD0,GF,PD1|Aut (M)|AY|1|^LR(PD0,GF,PD1,2005,"
96 S PT(63.02)="^LR(PD0,GF,PD1|El-Micr|EM|1|^LR(PD0,GF,PD1,2005,"
97 S PT(63.08)="^LR(PD0,GF,PD1|SrgPath|SP|1|^LR(PD0,GF,PD1,2005,"
98 S PT(63.09)="^LR(PD0,GF,PD1|Cytol|CY|1|^LR(PD0,GF,PD1,2005,"
99 S PT(63.2)="^LR(PD0,GF,PD1|Aut (G)|AU|1|^LR(PD0,GF,PD1,2005,"
100 S PT(74)="^RARPT(PD0|Rad||2|^RARPT(PD0,2005,"
101 S PT(130)="^SRF(PD0|Surgery||1|^SRF(PD0,2005,"
102 S PT(691)="^MCAR(691,PD0|Echo||2|^MCAR(691,PD0,2005,"
103 S PT(691.1)="^MCAR(691.1,PD0|Cath||2|^MCAR(691.1,PD0,2005,"
104 S PT(691.5)="^MCAR(691.5,PD0|ECG||2|^MCAR(691.5,PD0,2005,"
105 S PT(694)="^MCAR(694,PD0|Hema||2|^MCAR(694,PD0,2005,"
106 S PT(699)="^MCAR(699,PD0|Endo||2|^MCAR(699,PD0,2005,"
107 S PT(699.5)="^MCAR(699.5,PD0|Med||2|^MCAR(699.5,PD0,2005,"
108 ;S PT(8925)="^TIU(8925,PD0|TIU||2|^TIU(8925.91,""ADI"",PD0,"
109 S PT(8925)="^TIU(8925,PD0|TIU||2|^TIU(8925.91,""ADI"",PD0,"
110 S ERR="" F S ERR=$O(^XTMP("MAGCHK",NUMBER,"B",ERR)) Q:ERR="" D
111 . I TYPE="CO" S X=1 D Q:X
112 . . S:ERR="Patient pointer mismatch between Image Group and Image" X=0
113 . . S:ERR="Image and associated report have different patient pointers" X=0
114 . . S:ERR="Associated report does not point back to Image" X=0
115 . . Q
116 . S ERRTYPE(ERR)=0 I ERR="Images only point to Patient." K ERRTYPE(ERR) Q
117 . D HDR(ERR)
118 . S N=0
119 . S D0="" F S D0=$O(^XTMP("MAGCHK",NUMBER,"B",ERR,D0)) Q:D0="" D
120 . . N ASITE,DFN,IDFN,IPN,ISS4,PD0,PD1,PDFN,PF,PK,PPN,PSS4,X0,X2
121 . . S N=N+1
122 . . S ASITE=$P($G(^MAG(2005,D0,100)),"^",3)
123 . . S X0=$G(^MAG(2005,D0,0))
124 . . S X2=$G(^MAG(2005,D0,2))
125 . . S IDFN=$P(X0,"^",7) S:'IDFN IDFN="-?-"
126 . . S PF=$P(X2,"^",6),PD0=$P(X2,"^",7),PD1=$P(X2,"^",10)
127 . . S X=$G(PT(+PF),"|Unknown")
128 . . S PK=$P(X,"|",2)
129 . . ;S DFN=IDFN D DEM^VADPT S IPN=VADM(1),ISS4=$E(IPN,1)_$G(VA("BID"))
130 . . S XX=+$$PTLKP(IDFN,.IPN,.ISS4)
131 . . S (PPN,PDFN,PSS4)=""
132 . . D:ERR="Image and associated report have different patient pointers"
133 . . . N GF,GP,GR,GR0,GT,P0,T
134 . . . Q:PK="Unknown"
135 . . . S GR=$P(PT(PF),"|",1),GR0=GR_",0)"
136 . . . S GP=$P(PT(PF),"|",4)
137 . . . S P0=$G(@GR0,"^not defined"),PDFN=$P(P0,"^",GP)
138 . . . I PF\1=63 S PDFN=PD0
139 . . . I 'PDFN,IPN=PDFN S PDFN=IDFN
140 . . . Q:IDFN=PDFN
141 . . . S XX=+$$PTLKP(PDFN,.PPN,.PSS4)
142 . . . ;S DFN=PDFN D DEM^VADPT S PPN=VADM(1),PSS4=$E(PPN,1)_$G(VA("BID"))
143 . . . Q
144 . . D:ERR="Patient pointer mismatch between Image Group and Image"
145 . . . N G0,P0
146 . . . S P0=$P(X0,"^",10)
147 . . . S X0=$G(^MAG(2005,D0,0))
148 . . . S X2=$G(^MAG(2005,D0,2))
149 . . . S PDFN=$P(X0,"^",7) D:IDFN=PDFN
150 . . . . S G0=0 F S G0=$O(^MAG(2005,P0,1,G0)) Q:'G0 D Q:'G0
151 . . . . . S X0=$G(^MAG(2005,+$P($G(^MAG(2005,P0,1,G0,0)),"^",1),0))
152 . . . . . S PDFN=$P(X0,"^",7) S:PDFN'=IDFN G0=0
153 . . . . . Q
154 . . . . Q
155 . . . Q:PDFN=IDFN
156 . . . S XX=+$$PTLKP(PDFN,.PPN,.PSS4)
157 . . . ;S DFN=PDFN D DEM^VADPT S PPN=VADM(1),PSS4=$E(PPN,1)_$G(VA("BID"))
158 . . . Q
159 . . S LIN=LIN+1 D:LIN>IOSL HDR(ERR)
160 . . S X=PD0 S:PD1 X=X_"/"_PD1
161 . . I TYPE="CO",PK'="Rad" Q
162 . . Q:ERR="Images only point to Patient."
163 . . S ERRTYPE(ERR)=$G(ERRTYPE(ERR))+1
164 . . W !,$J(D0,7)," ",$$L(IPN,31)," ",$$L(PPN,31)," "
165 . . W $$L(ISS4,5)," ",$$L(PSS4,5)," "
166 . . W $J(IDFN,8)," ",$J(PDFN,8)," ",$$L(PK,8)," ",$J(X,5)," ",$J(ASITE,5)
167 . . S I=$O(^TMP("MAGMAIL",$J," "),-1)+1
168 . . S ^TMP("MAGMAIL",$J,I,0)=D0_"^"_IPN_"^"_PPN_"^"_ISS4_"^"_PSS4_"^"_IDFN_"^"_PDFN_"^"_PK_"^"_X_"^"_ERR_"^"_ASITE
169 . . Q
170 . Q
171 ;
172 D PN
173 W !,"S u m m a r y"
174 ;S X=$G(SQI(0)) W !!,+X," ",$P(X,"^",2),!!
175 S X=$P($G(^XTMP("MAGCHK",NUMBER,0)),"^",8) W !!,X," entries scanned."
176 S II=$O(^TMP("MAGMAIL",$J," "),-1)+1
177 S ^TMP("MAGMAIL",$J,II,0)=+X_" entries scanned."
178 S I="" F S I=$O(ERRTYPE(I)) Q:I="" D
179 . W !,$J($G(ERRTYPE(I)),7)," occurrence" W:+$G(ERRTYPE(I))'=1 "s" W " of ",I
180 . S II=$O(^TMP("MAGMAIL",$J," "),-1)+1
181 . S ^TMP("MAGMAIL",$J,II,0)=$G(ERRTYPE(I))_" occurrence"_$S($G(ERRTYPE(I))'=1:"s",1:"")_" of "_I
182 . Q
183 I +H1 D
184 . S X=$P(H2,",",1)-$P(H1,",",1)*86400+$P(H2,",",2)-$P(H1,",",2)
185 . W !!,"Database scan took "
186 . S HRS=X\3600 I +HRS S HRS=+HRS_$S(HRS>1:" hours ",1:" hour ") W HRS
187 . S MIN=X\60#60 I +MIN S MIN=+MIN_$S(MIN>1:" minutes ",1:" minute ") W MIN
188 . S SEC=X#60 I +SEC S SEC=+SEC_$S(SEC>1:" seconds ",1:" second ") W SEC
189 . S II=$O(^TMP("MAGMAIL",$J," "),-1)+1
190 . S ^TMP("MAGMAIL",$J,II,0)="Database scan took "_HRS_" "_MIN_" "_SEC
191 . Q
192 N XMY,XMTEXT,XMSUB
193 S XMY("G.MAG SERVER")=""
194 S XMTEXT="^TMP(""MAGMAIL"","_$J_","
195 S XMSUB="Imaging Integrity Check ("_TYPE_")"
196 ;
197 I TYPE="CO" I $P(^XTMP("MAGCHK",NUMBER,0),"^",7)="" D
198 . D ^XMD
199 . S $P(^XTMP("MAGCHK",NUMBER,0),"^",7)="MAILED"
200 . Q
201 ;
202 I TYPE="QA" I $P(^XTMP("MAGCHK",NUMBER,0),"^",9)="" D
203 . D ^XMD
204 . S $P(^XTMP("MAGCHK",NUMBER,0),"^",9)="MAILED"
205 . Q
206 K ^TMP("MAGMAIL",$J)
207 Q
208 ;
209L(X,N) Q $E(X_$J("",N),1,N)
210 ;
211PTLKP(DFN,IPN,ISS4) ;
212 S IPN="Unknown"
213 S ISS4="Unk"
214 I DFN="" Q "0^NO_DFN"
215 D DEM^VADPT
216 S:'VAERR IPN=VADM(1),ISS4=$E(IPN,1)_$G(VA("BID"))
217 I 'VAERR Q "1^SUCCESS"
218 Q "0^FAILED"
219 ;
220PN N X
221 S PAG=PAG+1,X="Page "_PAG,LIN=6
222 W:PAG'=1 @IOF
223 W DT#100," "
224 W $P("Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec"," ",DT\100#100)
225 W " ",DT\10000+1700,?(IOM-$L(X)),X
226 Q
227 ;
228HDR(ERR) ;
229 D PN
230 S HEADING=$S(TYPE="CO":"**** Report on Inconsistencies Caused by Global Moves ****",1:"**** Report of All Image-Related Inconsistencies Detected ****")
231 W !?(IOM-$L(HEADING)\2),HEADING
232 W !?(IOM-$L(ERR)\2),ERR,!
233 W !,"Image Patient Name Patient Name SSN4 SSN4 DFN DFN Package"
234 W !,"Number (First one found) (Other one found) (fst) (oth) (fst) (oth) Package IEN SITE"
235 W !,"======= =============================== =============================== ===== ===== ======== ======== ======= ======= ====="
236 W !
237 Q
238 ;
239QA ; Report for QA
240 D RPT("QA")
241 Q
242 ;
243CO ; Report for CO
244 D RPT("CO")
245 Q
246 ;
247TEST S IOSL=55,IOM=132,IO=$P,TYPE="QA" D WORK
248 Q
249 ;
250DOCU ;
251 ;^XTMP("MAGCHK",$J,0)=PURGE DATE^CREATE DATE^DESCRIPTION^STATUS^SCAN START^SCAN STOP^C0 MAILED^#SCANNED^QA MAILED
252 Q
Note: See TracBrowser for help on using the repository browser.