MAGGTUX1 ;WIOFO/GEK Imaging utility to track missing TYPE INDEX values.
;;3.0;IMAGING;**59**;Nov 27, 2007;Build 20
;;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
REVIEW ;
N CHK,FIX,MAGN
S CHK=$D(^XTMP("MAGGTUXC"))
S FIX=$D(^XTMP("MAGGTUX"))
N EQ S $P(EQ,"=",78)=""
W !,EQ
I 'CHK,'FIX W !,"No reports to review." Q
S X=$S(FIX:"F",1:"C")
I CHK&FIX D
. W !,"Review last Report of Checked or Fixed Index terms: C/F //F :" R X:30
I "fF"[$E(X) W !,"Starting Review of last Fixed Report:" S MAGN="MAGGTUX"
E W !,"Starting Review of last Checked Report:" S MAGN="MAGGTUXC"
W !,"Summary of search for Images where TYPE INDEX = null"
N I,PKG,BT,ICT,CT,J,JCT,TCT,TTCT
S BT=0
D 3
;
W !,"Last Image IEN missing a Type Index : ",$P($G(^XTMP(MAGN,0,"NT")),"-")
W ?41,$$FMTE^XLFDT($P($G(^XTMP(MAGN,0,"NT")),"-",2))
W !,"Last Image IEN missing All Index : ",$P($G(^XTMP(MAGN,0,"NI")),"-")
W ?41,$$FMTE^XLFDT($P($G(^XTMP(MAGN,0,"NI")),"-",2))
W !,"------------------------------"
S I="",TCT=0
W !,"Different settings of invalid INDEX Node"
W !,"Current Terms",?22,"Generated Terms",?50,"New Terms",!
F S I=$O(^XTMP(MAGN,"AAN40",I)) Q:I="" D
. S TCT=TCT+$G(^XTMP(MAGN,"AAN40",I))
. W !,I,?20,^XTMP(MAGN,"AAN40",I),?65,"= ",TCT
. S J="" F S J=$O(^XTMP(MAGN,"AAN40",I,"CVT",J)) Q:J="" D
. . W !,I,?20,"+ ",J,?45,"= ",^XTMP(MAGN,"AAN40",I,"CVT",J)
. Q
;
DISPLAY ; This is called after a CHECK or a FIX from MAGGTUX
N A
S A=$NA(^TMP($J,"MAGGTUX","RPT"))
D BUILD(A)
S I="" F S I=$O(@A@(I)) Q:I="" D MES^XPDUTL(^(I))
Q
MAIL ; This will mail results to the MAG SERVER mail group.
N A,MAGDT
S MAGDT=$P($$FMTE^XLFDT($$NOW^XLFDT),"@",1)
S A=$NA(^TMP($J,"MAGQ"))
D BUILD(A)
N XMSUB S XMSUB="Image Index Validate "_MAGDT_": Report"
S @A@(1)=$$GET1^DIQ(200,$G(DUZ),.01)_" "_$$GET1^DIQ(4,$G(DUZ(2)),.01)
D MAILSHR^MAGQBUT1
Q
BUILD(A) ;BUILD A TMP global of the report.
N CT
S CT=5 K @A
S CT=CT+1,@A@(CT)="================================================================="
S CT=CT+1,@A@(CT)="Start time : "_$$FMTE^XLFDT($P(^XTMP(MAGN,0),"^",2))
S CT=CT+1,@A@(CT)="End time : "_$P($G(^XTMP(MAGN,0,"END")),"^",1)
S CT=CT+1,@A@(CT)="Elapsed time : "_$P($G(^XTMP(MAGN,0,"END")),"^",2)
S CT=CT+1,@A@(CT)="Last Image IEN missing a Type Index : "_$P($G(^XTMP(MAGN,0,"NT")),"-")_" "_$$FMTE^XLFDT($P($G(^XTMP(MAGN,0,"NT")),"-",2))
S CT=CT+1,@A@(CT)="Last Image IEN missing All Index : "_$P($G(^XTMP(MAGN,0,"NI")),"-")_" "_$$FMTE^XLFDT($P($G(^XTMP(MAGN,0,"NI")),"-",2))
S CT=CT+1,@A@(CT)="Total Checked: "_$G(^XTMP(MAGN,"AATCHK"))
S CT=CT+1,@A@(CT)=" -- Entries Missing a Type Index -- "
S CT=CT+1,@A@(CT)="Total Study Groups & Single Images : "_+$G(^XTMP(MAGN,"AANT"))
S CT=CT+1,@A@(CT)="Total Group Images : "_$G(^XTMP(MAGN,"AAGRINT"))
S CT=CT+1,@A@(CT)=" -- Entries Missing all Index Terms -- "
S CT=CT+1,@A@(CT)="Total Study Groups & Single Images : "_+$G(^XTMP(MAGN,"AANI"))
S CT=CT+1,@A@(CT)="Total Group Images : "_$G(^XTMP(MAGN,"AAGRINI"))
S CT=CT+1,@A@(CT)=" -- Other Index checks -- "
S CT=CT+1,@A@(CT)=" Total Origin Index fixes : "_$G(^XTMP(MAGN,"AAOFX"))
S CT=CT+1,@A@(CT)=" CR -> CT fix : "_$G(^XTMP(MAGN,"AACRCT"))
S CT=CT+1,@A@(CT)=" Total DataBase Changes = "_+$G(^XTMP(MAGN,"AAFIX"))
S CT=CT+1,@A@(CT)=" "
S CT=CT+1,@A@(CT)="Also : Information gathered during Check/Fix"
S CT=CT+1,@A@(CT)=" - - - Generate Index Values and Merge - - - "
S CT=CT+1,@A@(CT)=" The Merged proc/spec not valid. No change.) "_$G(^XTMP(MAGN,"AANOMERG"))
S CT=CT+1,@A@(CT)=" The Merged proc/spec was okay. Changed. "_$G(^XTMP(MAGN,"AAOKMERG"))
S CT=CT+1,@A@(CT)=" - - - other - - - "
S CT=CT+1,@A@(CT)=" Total Groups of only 1 image "_$G(^XTMP(MAGN,"AAGO1"))
S CT=CT+1,@A@(CT)=" Total Groups of 0 images "_$G(^XTMP(MAGN,"AAGO0"))
S CT=CT+1,@A@(CT)=" Total Images w/No Patient "_$G(^XTMP(MAGN,"AANOPAT"))
S CT=CT+1,@A@(CT)=" Total Images w/No 0 node "_$G(^XTMP(MAGN,"AANOZ"))
S CT=CT+1,@A@(CT)=" Warnings: Generated Proc,Spec "_$G(^XTMP(MAGN,"AAINVG"))
S CT=CT+1,@A@(CT)=" Warnings: Entered Proc,Spec "_$G(^XTMP(MAGN,"AAINVO"))
S IEN=$P(^XTMP(MAGN,0),"^",3)
I +IEN D
. S CT=CT+1,@A@(CT)=" "
. S CT=CT+1,@A@(CT)="Last IEN Checked: "_IEN
. S CT=CT+1,@A@(CT)=" Capture Date: "_$$FMTE^XLFDT($P($G(^MAG(2005,IEN,2)),"^",1))
. Q
I IEN=0 D
. S CT=CT+1,@A@(CT)=" "
. S CT=CT+1,@A@(CT)="All Entries were checked"
. Q
S CT=CT+1,@A@(CT)=" "
S CT=CT+1,@A@(CT)="For a summary of the last Check or Fix process"
S CT=CT+1,@A@(CT)="Use the menu option: "
S CT=CT+1,@A@(CT)=" ""REV Review a Summary of the last Fix or Check process."""
S CT=CT+1,@A@(CT)="================================================================="
Q
;
3 ; called from above. Display the Spec - Proc problems
N MAIDX
S MAIDX="MAIDXG"
W !!,"Mismatch in the Generated Values of Specialty/SubSpec <-> Proc/Event",!
D 31
S MAIDX="MAIDXO"
W !!,"Mismatch in the User entered Values of Specialty/SubSpec <-> Proc/Event",!
D 31
Q
31 ;
N IT,IS,IP
N I,SD,SUBO,I3,CT,J,MY
S IT="" F S IT=$O(^XTMP(MAGN,MAIDX,IT)) Q:IT="" D
. S IS="" F S IS=$O(^XTMP(MAGN,MAIDX,IT,IS)) Q:IS="" D
. . S IP="" F S IP=$O(^XTMP(MAGN,MAIDX,IT,IS,IP)) Q:IP="" D
. . . S CT=^(IP)
. . . K MY D VALTUX1^MAGGTUX3(.MY,IT,IS,IP) W !,CT," "
. . . S I="" F S I=$O(MY(I)) Q:I="" W ?7,MY(I),!
. . . I $L($O(^MAG(2005.85,IP,1,"B",""))) W ?35,"Valid specs: "
. . . S I3="" F S I3=$O(^MAG(2005.85,IP,1,"B",I3)) Q:'I3 D
. . . . W !,?35,$P(^MAG(2005.84,I3,0),"^")
. . . . S SUBO=$P(^MAG(2005.84,I3,0),"^",3)
. . . . I SUBO W " <",$P(^MAG(2005.84,SUBO,0),"^"),">"
. . . . Q
. . . K ^TMP($J,"MAGDCT")
. . . S SD="" F S SD=$O(^XTMP(MAGN,"MAIDSD",+IT,+IS,+IP,"SD",SD)) Q:SD="" D
. . . . S ^TMP($J,"MAGDCT",^XTMP(MAGN,"MAIDSD",+IT,+IS,+IP,"SD",SD))="Desc: "_SD
. . . S CT="" F J=1:1:5 S CT=$O(^TMP($J,"MAGDCT",CT),-1) Q:CT="" W !,?7,CT,?15,"Desc: ",^TMP($J,"MAGDCT",CT)
. . . W !
. . . Q
. . Q
. Q
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HMAGGTUX1 7496 printed Dec 13, 2024@02:03:36 Page 2
MAGGTUX1 ;WIOFO/GEK Imaging utility to track missing TYPE INDEX values.
+1 ;;3.0;IMAGING;**59**;Nov 27, 2007;Build 20
+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
REVIEW ;
+1 NEW CHK,FIX,MAGN
+2 SET CHK=$DATA(^XTMP("MAGGTUXC"))
+3 SET FIX=$DATA(^XTMP("MAGGTUX"))
+4 NEW EQ
SET $PIECE(EQ,"=",78)=""
+5 WRITE !,EQ
+6 IF 'CHK
IF 'FIX
WRITE !,"No reports to review."
QUIT
+7 SET X=$SELECT(FIX:"F",1:"C")
+8 IF CHK&FIX
Begin DoDot:1
+9 WRITE !,"Review last Report of Checked or Fixed Index terms: C/F //F :"
READ X:30
End DoDot:1
+10 IF "fF"[$EXTRACT(X)
WRITE !,"Starting Review of last Fixed Report:"
SET MAGN="MAGGTUX"
+11 IF '$TEST
WRITE !,"Starting Review of last Checked Report:"
SET MAGN="MAGGTUXC"
+12 WRITE !,"Summary of search for Images where TYPE INDEX = null"
+13 NEW I,PKG,BT,ICT,CT,J,JCT,TCT,TTCT
+14 SET BT=0
+15 DO 3
+16 ;
+17 WRITE !,"Last Image IEN missing a Type Index : ",$PIECE($GET(^XTMP(MAGN,0,"NT")),"-")
+18 WRITE ?41,$$FMTE^XLFDT($PIECE($GET(^XTMP(MAGN,0,"NT")),"-",2))
+19 WRITE !,"Last Image IEN missing All Index : ",$PIECE($GET(^XTMP(MAGN,0,"NI")),"-")
+20 WRITE ?41,$$FMTE^XLFDT($PIECE($GET(^XTMP(MAGN,0,"NI")),"-",2))
+21 WRITE !,"------------------------------"
+22 SET I=""
SET TCT=0
+23 WRITE !,"Different settings of invalid INDEX Node"
+24 WRITE !,"Current Terms",?22,"Generated Terms",?50,"New Terms",!
+25 FOR
SET I=$ORDER(^XTMP(MAGN,"AAN40",I))
if I=""
QUIT
Begin DoDot:1
+26 SET TCT=TCT+$GET(^XTMP(MAGN,"AAN40",I))
+27 WRITE !,I,?20,^XTMP(MAGN,"AAN40",I),?65,"= ",TCT
+28 SET J=""
FOR
SET J=$ORDER(^XTMP(MAGN,"AAN40",I,"CVT",J))
if J=""
QUIT
Begin DoDot:2
+29 WRITE !,I,?20,"+ ",J,?45,"= ",^XTMP(MAGN,"AAN40",I,"CVT",J)
End DoDot:2
+30 QUIT
End DoDot:1
+31 ;
DISPLAY ; This is called after a CHECK or a FIX from MAGGTUX
+1 NEW A
+2 SET A=$NAME(^TMP($JOB,"MAGGTUX","RPT"))
+3 DO BUILD(A)
+4 SET I=""
FOR
SET I=$ORDER(@A@(I))
if I=""
QUIT
DO MES^XPDUTL(^(I))
+5 QUIT
MAIL ; This will mail results to the MAG SERVER mail group.
+1 NEW A,MAGDT
+2 SET MAGDT=$PIECE($$FMTE^XLFDT($$NOW^XLFDT),"@",1)
+3 SET A=$NAME(^TMP($JOB,"MAGQ"))
+4 DO BUILD(A)
+5 NEW XMSUB
SET XMSUB="Image Index Validate "_MAGDT_": Report"
+6 SET @A@(1)=$$GET1^DIQ(200,$GET(DUZ),.01)_" "_$$GET1^DIQ(4,$GET(DUZ(2)),.01)
+7 DO MAILSHR^MAGQBUT1
+8 QUIT
BUILD(A) ;BUILD A TMP global of the report.
+1 NEW CT
+2 SET CT=5
KILL @A
+3 SET CT=CT+1
SET @A@(CT)="================================================================="
+4 SET CT=CT+1
SET @A@(CT)="Start time : "_$$FMTE^XLFDT($PIECE(^XTMP(MAGN,0),"^",2))
+5 SET CT=CT+1
SET @A@(CT)="End time : "_$PIECE($GET(^XTMP(MAGN,0,"END")),"^",1)
+6 SET CT=CT+1
SET @A@(CT)="Elapsed time : "_$PIECE($GET(^XTMP(MAGN,0,"END")),"^",2)
+7 SET CT=CT+1
SET @A@(CT)="Last Image IEN missing a Type Index : "_$PIECE($GET(^XTMP(MAGN,0,"NT")),"-")_" "_$$FMTE^XLFDT($PIECE($GET(^XTMP(MAGN,0,"NT")),"-",2))
+8 SET CT=CT+1
SET @A@(CT)="Last Image IEN missing All Index : "_$PIECE($GET(^XTMP(MAGN,0,"NI")),"-")_" "_$$FMTE^XLFDT($PIECE($GET(^XTMP(MAGN,0,"NI")),"-",2))
+9 SET CT=CT+1
SET @A@(CT)="Total Checked: "_$GET(^XTMP(MAGN,"AATCHK"))
+10 SET CT=CT+1
SET @A@(CT)=" -- Entries Missing a Type Index -- "
+11 SET CT=CT+1
SET @A@(CT)="Total Study Groups & Single Images : "_+$GET(^XTMP(MAGN,"AANT"))
+12 SET CT=CT+1
SET @A@(CT)="Total Group Images : "_$GET(^XTMP(MAGN,"AAGRINT"))
+13 SET CT=CT+1
SET @A@(CT)=" -- Entries Missing all Index Terms -- "
+14 SET CT=CT+1
SET @A@(CT)="Total Study Groups & Single Images : "_+$GET(^XTMP(MAGN,"AANI"))
+15 SET CT=CT+1
SET @A@(CT)="Total Group Images : "_$GET(^XTMP(MAGN,"AAGRINI"))
+16 SET CT=CT+1
SET @A@(CT)=" -- Other Index checks -- "
+17 SET CT=CT+1
SET @A@(CT)=" Total Origin Index fixes : "_$GET(^XTMP(MAGN,"AAOFX"))
+18 SET CT=CT+1
SET @A@(CT)=" CR -> CT fix : "_$GET(^XTMP(MAGN,"AACRCT"))
+19 SET CT=CT+1
SET @A@(CT)=" Total DataBase Changes = "_+$GET(^XTMP(MAGN,"AAFIX"))
+20 SET CT=CT+1
SET @A@(CT)=" "
+21 SET CT=CT+1
SET @A@(CT)="Also : Information gathered during Check/Fix"
+22 SET CT=CT+1
SET @A@(CT)=" - - - Generate Index Values and Merge - - - "
+23 SET CT=CT+1
SET @A@(CT)=" The Merged proc/spec not valid. No change.) "_$GET(^XTMP(MAGN,"AANOMERG"))
+24 SET CT=CT+1
SET @A@(CT)=" The Merged proc/spec was okay. Changed. "_$GET(^XTMP(MAGN,"AAOKMERG"))
+25 SET CT=CT+1
SET @A@(CT)=" - - - other - - - "
+26 SET CT=CT+1
SET @A@(CT)=" Total Groups of only 1 image "_$GET(^XTMP(MAGN,"AAGO1"))
+27 SET CT=CT+1
SET @A@(CT)=" Total Groups of 0 images "_$GET(^XTMP(MAGN,"AAGO0"))
+28 SET CT=CT+1
SET @A@(CT)=" Total Images w/No Patient "_$GET(^XTMP(MAGN,"AANOPAT"))
+29 SET CT=CT+1
SET @A@(CT)=" Total Images w/No 0 node "_$GET(^XTMP(MAGN,"AANOZ"))
+30 SET CT=CT+1
SET @A@(CT)=" Warnings: Generated Proc,Spec "_$GET(^XTMP(MAGN,"AAINVG"))
+31 SET CT=CT+1
SET @A@(CT)=" Warnings: Entered Proc,Spec "_$GET(^XTMP(MAGN,"AAINVO"))
+32 SET IEN=$PIECE(^XTMP(MAGN,0),"^",3)
+33 IF +IEN
Begin DoDot:1
+34 SET CT=CT+1
SET @A@(CT)=" "
+35 SET CT=CT+1
SET @A@(CT)="Last IEN Checked: "_IEN
+36 SET CT=CT+1
SET @A@(CT)=" Capture Date: "_$$FMTE^XLFDT($PIECE($GET(^MAG(2005,IEN,2)),"^",1))
+37 QUIT
End DoDot:1
+38 IF IEN=0
Begin DoDot:1
+39 SET CT=CT+1
SET @A@(CT)=" "
+40 SET CT=CT+1
SET @A@(CT)="All Entries were checked"
+41 QUIT
End DoDot:1
+42 SET CT=CT+1
SET @A@(CT)=" "
+43 SET CT=CT+1
SET @A@(CT)="For a summary of the last Check or Fix process"
+44 SET CT=CT+1
SET @A@(CT)="Use the menu option: "
+45 SET CT=CT+1
SET @A@(CT)=" ""REV Review a Summary of the last Fix or Check process."""
+46 SET CT=CT+1
SET @A@(CT)="================================================================="
+47 QUIT
+48 ;
3 ; called from above. Display the Spec - Proc problems
+1 NEW MAIDX
+2 SET MAIDX="MAIDXG"
+3 WRITE !!,"Mismatch in the Generated Values of Specialty/SubSpec <-> Proc/Event",!
+4 DO 31
+5 SET MAIDX="MAIDXO"
+6 WRITE !!,"Mismatch in the User entered Values of Specialty/SubSpec <-> Proc/Event",!
+7 DO 31
+8 QUIT
31 ;
+1 NEW IT,IS,IP
+2 NEW I,SD,SUBO,I3,CT,J,MY
+3 SET IT=""
FOR
SET IT=$ORDER(^XTMP(MAGN,MAIDX,IT))
if IT=""
QUIT
Begin DoDot:1
+4 SET IS=""
FOR
SET IS=$ORDER(^XTMP(MAGN,MAIDX,IT,IS))
if IS=""
QUIT
Begin DoDot:2
+5 SET IP=""
FOR
SET IP=$ORDER(^XTMP(MAGN,MAIDX,IT,IS,IP))
if IP=""
QUIT
Begin DoDot:3
+6 SET CT=^(IP)
+7 KILL MY
DO VALTUX1^MAGGTUX3(.MY,IT,IS,IP)
WRITE !,CT," "
+8 SET I=""
FOR
SET I=$ORDER(MY(I))
if I=""
QUIT
WRITE ?7,MY(I),!
+9 IF $LENGTH($ORDER(^MAG(2005.85,IP,1,"B","")))
WRITE ?35,"Valid specs: "
+10 SET I3=""
FOR
SET I3=$ORDER(^MAG(2005.85,IP,1,"B",I3))
if 'I3
QUIT
Begin DoDot:4
+11 WRITE !,?35,$PIECE(^MAG(2005.84,I3,0),"^")
+12 SET SUBO=$PIECE(^MAG(2005.84,I3,0),"^",3)
+13 IF SUBO
WRITE " <",$PIECE(^MAG(2005.84,SUBO,0),"^"),">"
+14 QUIT
End DoDot:4
+15 KILL ^TMP($JOB,"MAGDCT")
+16 SET SD=""
FOR
SET SD=$ORDER(^XTMP(MAGN,"MAIDSD",+IT,+IS,+IP,"SD",SD))
if SD=""
QUIT
Begin DoDot:4
+17 SET ^TMP($JOB,"MAGDCT",^XTMP(MAGN,"MAIDSD",+IT,+IS,+IP,"SD",SD))="Desc: "_SD
End DoDot:4
+18 SET CT=""
FOR J=1:1:5
SET CT=$ORDER(^TMP($JOB,"MAGDCT",CT),-1)
if CT=""
QUIT
WRITE !,?7,CT,?15,"Desc: ",^TMP($JOB,"MAGDCT",CT)
+19 WRITE !
+20 QUIT
End DoDot:3
+21 QUIT
End DoDot:2
+22 QUIT
End DoDot:1
+23 QUIT
