| 1 | MAGGTUX ;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
|
|---|
| 20 | CHECK ; Check the entries, NO DATABASE changes.
|
|---|
| 21 | D 1(0,"MAGGTUXC")
|
|---|
| 22 | Q
|
|---|
| 23 | FIX ; Fix/Check INDEX values in Image File entries.
|
|---|
| 24 | D 1(1,"MAGGTUX")
|
|---|
| 25 | Q
|
|---|
| 26 | 1(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
|
|---|
| 54 | TASK ;
|
|---|
| 55 | D START(COMMIT,MAGN,QUEUED)
|
|---|
| 56 | Q
|
|---|
| 57 | START(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.
|
|---|
| 212 | END ;
|
|---|
| 213 | L -MAGTMP("VALIDATE INDEX TERMS")
|
|---|
| 214 | Q
|
|---|
| 215 | ERR ;
|
|---|
| 216 | L -MAGTMP("VALIDATE INDEX TERMS")
|
|---|
| 217 | D @^%ZOSF("ERRTN")
|
|---|
| 218 | Q
|
|---|
| 219 | EST() ;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 | ;
|
|---|
| 229 | PRLINE ; 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
|
|---|
| 235 | PRHDR ; 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
|
|---|
| 241 | REVIEW G REVIEW^MAGGTUX1
|
|---|
| 242 | Q
|
|---|
