source: WorldVistAEHR/trunk/r/IMAGING-MAG-ZMAG/MAGGTUX.m@ 808

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

initial load of WorldVistAEHR
File size: 9.5 KB
RevLine 
[613]1MAGGTUX ;WIOFO/GEK Imaging utility to validate INDEX values.
2 ;;3.0;IMAGING;**59**;Nov 27, 2007;Build 20
3 ;;Per VHA Directive 2004-038, this routine should not be modified.
4 ;; +---------------------------------------------------------------+
5 ;; | Property of the US Government. |
6 ;; | No permission to copy or redistribute this software is given. |
7 ;; | Use of unreleased versions of this software requires the user |
8 ;; | to execute a written test agreement with the VistA Imaging |
9 ;; | Development Office of the Department of Veterans Affairs, |
10 ;; | telephone (301) 734-0100. |
11 ;; | |
12 ;; | The Food and Drug Administration classifies this software as |
13 ;; | a medical device. As such, it may not be changed in any way. |
14 ;; | Modifications to this software may result in an adulterated |
15 ;; | medical device under 21CFR820, the use of which is considered |
16 ;; | to be a violation of US Federal Statutes. |
17 ;; +---------------------------------------------------------------+
18 ;;
19 Q
20CHECK ; Check the entries, NO DATABASE changes.
21 D 1(0,"MAGGTUXC")
22 Q
23FIX ; Fix/Check INDEX values in Image File entries.
24 D 1(1,"MAGGTUX")
25 Q
261(COMMIT,MAGN) ; Start here.
27 I '$D(DUZ) W !,"DUZ is undefined. Quitting." Q
28 N DESC,ANS,ZTDTH,ZTIO,ZTRTN,ZTDESC,ZTSAVE,ZTSK ; -- TaskMan variables
29 I 'COMMIT W !," **** Just Checking entries, no DataBase changes will occur. ****",!
30 W !,"Validate Image Index Terms:"
31 W !," The Image File is searched for invalid or missing index values."
32 W !," The Image Index Generate and Commit functions are used"
33 W !," to fix the incorrect Index values."
34 W !
35 W !,"For a summary of the index values that will be changed."
36 W !," use the menu option: CHK - Check Image File for missing Index values"
37 W !," "
38 W !,"To Fix the invalid index values in the Image File (#2005)."
39 W !," use the menu option: FIX - Fix missing Index values in Image File"
40 W !
41 I 'COMMIT W !," **** Just Checking entries, No DataBase changes will occur. ****",!
42 E W !," **** Fixing invalid entries, DataBase changes Will occur. ****",!
43 D TASKMAN^MAGXCVP(.ANS)
44 I "^"=ANS W !,"Canceled. " Q
45 S ZTSK=0 I ANS="" D START(COMMIT,MAGN,0) Q
46 S ZTRTN="TASK^MAGGTUX"
47 S DESC=$S(COMMIT:"FIX INVALID INDEX VALUES",1:"CHECK FOR INVALID INDEX VALUES")
48 S ZTDESC=DESC
49 S ZTDTH=ANS,ZTIO=""
50 S ZTSAVE("COMMIT")=COMMIT,ZTSAVE("MAGN")=MAGN,ZTSAVE("QUEUED")=1
51 D ^%ZTLOAD
52 W !,DESC_" Has been Queued as task# : "_ZTSK
53 Q
54TASK ;
55 D START(COMMIT,MAGN,QUEUED)
56 Q
57START(COMMIT,MAGN,QUEUED) ;Start here.
58 N $ETRAP,$ESTACK S $ETRAP="D ERR^"_$T(+0)
59 L +MAGTMP("VALIDATE INDEX TERMS"):0 E D Q
60 . I 'QUEUED W !,"Image Index Validate process is currently running. Try later." Q
61 . S XMSUB="Image Index Validate wasn't started"
62 . S ^TMP($J,"MAGQ",1)="You attempted to Task the Index Validate process, but the"
63 . S ^TMP($J,"MAGQ",2)="Image Validate process is currently running. Please try later."
64 . D MAILSHR^MAGQBUT1
65 . Q
66 N DOT,N0,N40,OL40,N2,MDFN,IXT,IXP,IXS,IXO,ST,ET,NORG,ISGRP,X,J,RADCT,RADCR,CDT,IEN,INDXD
67 N PKG,SD,TIM,TITLE,TIUDA,TTLDA,MRY,LNT,LNI,X1,STTIME,ENDTIME,ELSP,%H,%
68 N GRINT,NI,NOPAT,NOZ,INVG,CRCT,INVO,GRINI,NT,CT,STOP,LN,GO1,GO0,ORG,OFX,NOMERG,OKMERG,FIX
69 S (GRINT,NI,NOPAT,NOZ,INVG,CRCT,INVO,GRINI,NT,CT,STOP,LN,GO1,GO0,ORG,OFX,NOMERG,OKMERG,FIX)=0
70 ; Write 200 lines to screen.
71 S DOT=$P(($P(^MAG(2005,0),"^",4)/200),".",1)
72 S IEN="A"
73 ; if it was started and stopped, continue.
74 ; ^XTMP("MAGGTUX,0)=PurgeDate^CreateDate^LastIENChecked^HighestIENChecked^NumberChecked^Description
75 ;
76 I $D(^XTMP(MAGN,0)) D INIT^MAGGTUX2
77 S STTIME=$$NOW^XLFDT
78 I 'QUEUED D I STOP G END
79 . I 'COMMIT W !!,"Just Checking Index Terms, NO CHANGES to database. (Q to quit)"
80 . E W !!,"Invalid entries will be fixed. Database will be modified (Q to quit)"
81 . W !!," Press 'Q' at any time to QUIT. It can be resumed later.",!
82 . W !,"Ready to Start Y/N N// " R X:30
83 . I "Nn"[X W !!,"Canceled." S STOP=1 Q
84 . W !,"Starting at "_$$FMTE^XLFDT(STTIME)
85 . Q
86 ; Start.....
87 ; Set XTMP Dates
88 I IEN="A" K ^XTMP(MAGN) S $P(^XTMP(MAGN,0),"^",4)=$O(^MAG(2005,IEN),-1) ; Keep the Highest IEN checked.
89 S X1=DT,X2=14 D C^%DTC S $P(^XTMP(MAGN,0),"^",1,2)=X_"^"_$$NOW^XLFDT
90 S $P(^XTMP(MAGN,0),"^",6)="Fix Invalid Index Nodes"
91 ; Set variables to check the CR - CT problem.
92 S RADCR=+$O(^MAG(2005.85,"B","COMPUTED RADIOGRAPHY",""))
93 S RADCT=+$O(^MAG(2005.85,"B","COMPUTED TOMOGRAPHY",""))
94 ;
95 D PRHDR
96 S ST=$P($H,",",2) ; Start Time
97 S TIM=$P(^MAG(2005,0),"^",4) ; Total Images
98 F S IEN=$O(^MAG(2005,IEN),-1) Q:IEN=0 D I STOP Q ;G END
99 . R X:0 I X="Q" D Q
100 . . S STOP=1
101 . . I 'QUEUED W ! D MES^XPDUTL(" Function interrupted. ")
102 . . Q
103 . S ISGRP=0
104 . S N0=$G(^MAG(2005,IEN,0))
105 . S N2=$G(^MAG(2005,IEN,2))
106 . S N40=$G(^MAG(2005,IEN,40))
107 . S MDFN=+$P(N0,"^",7)
108 . S IXT=$P(N40,"^",3),IXS=$P(N40,"^",5),IXP=$P(N40,"^",4),IXO=$P(N40,"^",6)
109 . S CT=CT+1
110 . I (CT=1)!(CT#DOT=0)!($O(^MAG(2005,IEN),-1)=0) D PRLINE
111 . ; Count NO Patient, No Zero Node
112 . I 'MDFN S NOPAT=NOPAT+1 Q
113 . I N0="" S NOZ=NOZ+1 Q
114 . ; Count Groups of 1, No change.
115 . I $P(N0,"^",6)=11 S ISGRP=1 I $P($G(^MAG(2005,IEN,1,0)),"^",4)=1 S GO1=GO1+1
116 . I ISGRP I $O(^MAG(2005,IEN,1,0))="" S GO0=GO0+1 Q
117 . ;
118 . ; Chk ORIGIN (fld #45) had 'VA' not 'V'.
119 . I '("VNFD"[$P(N40,"^",6)) D CHK45^MAGGTUX2(.N40,IEN)
120 . ;
121 . ; Was a CR, CT mismapping, this will fix it.
122 . I RADCR=IXP D CHKCR^MAGGTUX2(.N40,IEN)
123 . ;
124 . ; Validate the Proc/Event <-> Spec/SubSpec dependency
125 . ; Check TYPE is Clinical, All are Active.
126 . I IXT D VALIND^MAGGTUX2 Q ;If image has TYPE, Check then Quit.
127 . ;
128 . ; Counting problems
129 . ; If no index values.
130 . I N40="" D
131 . . I $P(N0,"^",10) S GRINI=GRINI+1 ; GRoupImageNoIndex
132 . . E S NI=NI+1 ; NoIndex
133 . . S LNI=IEN_"-"_$P(N2,"^",1)
134 . . Q
135 . ;
136 . ; If this case follows the Majority of invalid 40 Nodes
137 . ; i.e. PKG^^^^^V PKG^^^^^VA then Kill and ReGenerate later
138 . I (N40'="") D
139 . . I $P(N0,"^",10) S GRINT=GRINT+1 ; Group Image with No Type
140 . . E S NT=NT+1 ; NoType : group or single
141 . . S ^XTMP(MAGN,"AAN40",N40)=$G(^XTMP(MAGN,"AAN40",N40))+1
142 . . S ^XTMP(MAGN,"AAN40",N40,"IEN")=IEN
143 . . S LNT=IEN_"-"_$P(N2,"^",1)
144 . . ; if 40 node is just default PKG and ORIGIN, we kill and regenerate.
145 . . ; Don't kill N40 if Origin is F,D or N
146 . . I N40?.A1"^^^^^".E I "V"[$P(N40,"^",6) S N40=""
147 . . Q
148 . ;
149 . ; Use Patch 31 Utils to Generate Index values
150 . I N40="" D Q
151 . . I COMMIT D
152 . . . ; GENERATE AND COMMIT INDEX VALUES.
153 . . . D GENIEN^MAGXCVI(IEN,.INDXD)
154 . . . I $P(INDXD,"^",6)="" S $P(INDXD,"^",6)="V"
155 . . . S ^MAG(2005,IEN,40)=INDXD
156 . . . S ^MAGIXCVT(2006.96,IEN)=2 ; status = 2 ( generate by Patch 59)
157 . . . S FIX=FIX+1
158 . . . D ENTRY^MAGLOG("INDEX-ALL",DUZ,IEN,"TUX59",MDFN,1)
159 . . . Q
160 . . Q
161 . ; 40 node is missing TYPE
162 . ; - has Spec and/or Proc
163 . ; - or Origin is not V.
164 . ; Compare old to new, only set missing pieces, (don't overwrite)
165 . ; If the merged 40 node doesn't pass VAL59G,
166 . ; Then revert to old Spec and Proc but keep Generated Type.
167 . ;
168 . D GENIEN^MAGXCVI(IEN,.INDXD)
169 . I $P(INDXD,"^",6)="" S $P(INDXD,"^",6)="V"
170 . S OL40=N40
171 . ; We're not changing existing values of Spec,Proc or Origin
172 . F J=1:1:6 I '$L($P(N40,"^",J)) S $P(N40,"^",J)=$P(INDXD,"^",J)
173 . ; Validate the merged Spec and Proc dependency, may be invalid.
174 . D VALMERG^MAGGTUX2(OL40,.N40) ;
175 . I '$D(^XTMP(MAGN,"AAN40",OL40,"CVT",INDXD)) S ^XTMP(MAGN,"AAN40",OL40,"CVT",INDXD)=N40
176 . I COMMIT D
177 . . S ^MAG(2005,IEN,40)=N40
178 . . S FIX=FIX+1
179 . . S ^MAGIXCVT(2006.96,IEN)=2 ; 2 is set of codes - converted by Patch 59
180 . . D ENTRY^MAGLOG("INDEX-42",DUZ,IEN,"TUX59",MDFN,1)
181 . . Q
182 . Q
183 S ENDTIME=$$NOW^XLFDT
184 S %H=$P($H,",")_","_($P($H,",",2)-ST) D YMD^%DTC
185 S ELSP=$P($$FMTE^XLFDT(X_%),"@",2)
186 S ^XTMP(MAGN,0,"END")=$$FMTE^XLFDT(ENDTIME)_"^"_ELSP
187 S $P(^XTMP(MAGN,0),"^",3)=IEN ; last IEN Checked.
188 S $P(^XTMP(MAGN,0),"^",5)=$P(^XTMP(MAGN,0),"^",5)+CT
189 ;
190 S ^XTMP(MAGN,"AATCHK")=$G(^XTMP(MAGN,"AATCHK"))+CT
191 S ^XTMP(MAGN,"AANT")=NT
192 S ^XTMP(MAGN,"AANI")=NI
193 S ^XTMP(MAGN,"AAGRINT")=GRINT
194 S ^XTMP(MAGN,"AAGRINI")=GRINI
195 S ^XTMP(MAGN,"AAGO1")=GO1
196 S ^XTMP(MAGN,"AAGO0")=GO0
197 S ^XTMP(MAGN,"AAOFX")=OFX
198 S ^XTMP(MAGN,"AAINVG")=INVG
199 S ^XTMP(MAGN,"AAINVO")=INVO
200 S ^XTMP(MAGN,"AANOMERG")=NOMERG
201 S ^XTMP(MAGN,"AAOKMERG")=OKMERG
202 S ^XTMP(MAGN,"AACRCT")=CRCT
203 S ^XTMP(MAGN,"AAN40","no index")=GRINI+NI
204 S ^XTMP(MAGN,"AANOPAT")=NOPAT
205 S ^XTMP(MAGN,"AANOZ")=NOZ
206 S ^XTMP(MAGN,0,"NT")=$G(LNT)
207 S ^XTMP(MAGN,0,"NI")=$G(LNI)
208 I FIX S ^XTMP(MAGN,"AAFIX")=FIX
209 I 'QUEUED D DISPLAY^MAGGTUX1
210 D MAIL^MAGGTUX1
211 ; KILL LOCKS.
212END ;
213 L -MAGTMP("VALIDATE INDEX TERMS")
214 Q
215ERR ;
216 L -MAGTMP("VALIDATE INDEX TERMS")
217 D @^%ZOSF("ERRTN")
218 Q
219EST() ;Estimate time remaining.
220 Q:'$G(ST) "" ; we didn't start yet.
221 N ET,EST,PS ; Elapsed Time, Estimate Time, Number Per Second.
222 S ET=$P($H,",",2)-ST I ET<2 Q "" ; Elapsed Time (seconds)
223 I (CT/ET)<1 Q ""
224 S PS=$P(CT/ET,".") ; number Per second
225 S EST=$P(((TIM-CT)/PS),".") ;remaining/ (num/sec) = seconds remaining
226 S %H=$P($H,",")_","_EST D YMD^%DTC
227 Q $P($$FMTE^XLFDT(X_%),"@",2)
228 ;
229PRLINE ; Print a line of current counts
230 Q:QUEUED
231 S CDT=$$FMTE^XLFDT($P($G(^MAG(2005,IEN,2)),"^",1),"2DF") ; Capture DaTe
232 W !,IEN,?10,CDT,?22,CT,?36,NT,?48,NI,?64,$$EST_" ..."
233 S LN=LN+1 I LN#10=0 D PRHDR
234 Q
235PRHDR ; Print a header and estimate of time.
236 ; For Test DataBase, put code to Hang here for 1 sec. (magslow)
237 Q:QUEUED
238 I 'COMMIT W !,"Just Checking Index Terms, NO CHANGES to database. (Q to quit)"
239 W !,"IEN Saved #checked No Type No Index values est: "
240 Q
241REVIEW G REVIEW^MAGGTUX1
242 Q
Note: See TracBrowser for help on using the repository browser.