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