MAGDLBV ;WOIFO/EdM - Validate Table with failed DICOM entries ; 12/16/2004 06:59
;;3.0;IMAGING;**51**;26-August-2005
;; +---------------------------------------------------------------+
;; | 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
;
W !!,"Starting Validation of data in DICOM Failed Images Table.",!
D VALIDATE(.OUT,1)
W !!,OUT," entr",$S(OUT=1:"y",1:"ies")," currently in database.",!
Q
;
VALIDATE(OUT,MENU) ; RPC = MAG DICOM CORRECT VALIDATE
N D0,D1,FIXED,L0,L1,LOC,N0,N1,TP,V,X
L +^MAGD(2006.575):1E9
S MENU=+$G(MENU)
F X="AD","AFX","B","D","F" K ^MAGD(2006.575,X)
S (L0,N0)=0
S D0=0 F S D0=$O(^MAGD(2006.575,D0)) Q:'D0 D
. S X=$G(^MAGD(2006.575,D0,0)) I X="" K ^MAGD(2006.575,D0) Q
. S L0=D0,N0=N0+1,(L1,N1)=0
. S FIXED=+$G(^MAGD(2006.575,D0,"FIXD"))
. S TYPE=$P($G(^MAGD(2006.575,D0,"TYPE")),"^",1)
. S V=$P(X,"^",1) S:V'="" ^MAGD(2006.575,"B",V,D0)=""
. S V=$P(X,"^",3) I V'="",'FIXED,TYPE="CON" S ^MAGD(2006.575,"D",V,D0)=""
. S X=$G(^MAGD(2006.575,D0,1)),LOC=$P(X,"^",5)
. S V=$P(X,"^",3) I V'="",'FIXED,TYPE="CON" S ^MAGD(2006.575,"AD",V,D0)=""
. S FIXED=+$G(^MAGD(2006.575,D0,"FIXD"))
. S V=$P(X,"^",4) I FIXED,LOC'="",V'="" S ^MAGD(2006.575,"AFX",LOC,V,D0)=""
. S V=$P($G(^MAGD(2006.575,D0,"ASUID")),"^",1)
. I LOC'="",V'="" S ^MAGD(2006.575,"F",LOC,V,D0)=""
. S D1=0 F S D1=$O(^MAGD(2006.575,D0,"RLATE",D1)) Q:'D1 D
. . S X=+$G(^MAGD(2006.575,D0,"RLATE",D1,0))
. . I 'X D Q
. . . W:MENU !,"Invalid pointer to related entry: """_X_"""."
. . . K ^MAGD(2006.575,D0,"RLATE",D1)
. . . Q
. . I '$D(^MAGD(2006.575,X)) D Q
. . . W:MENU !,"Pointer to non-existent related entry: """_X_"""."
. . . K ^MAGD(2006.575,D0,"RLATE",D1)
. . . K ^MAGD(2006.575,D0,"RLATE","B",X,D1)
. . . Q
. . S L1=D1,N1=N1+1
. . Q
. I 'N1 K ^MAGD(2006.575,D0,"RLATE") Q
. S ^MAGD(2006.575,D0,"RLATE",0)="^2006.57526PA^"_L1_"^"_N1
. ;
. S X="" F S X=$O(^MAGD(2006.575,D0,"RLATE","B",X)) Q:X="" D
. . I '$D(^MAGD(2006.575,X)) D Q
. . . W:MENU !,"Cross-reference for non-existent related entry: """_X_"""."
. . . K ^MAGD(2006.575,D0,"RLATE","B",X)
. . . Q
. . S D1="" F S D1=$O(^MAGD(2006.575,D0,"RLATE","B",X,D1)) Q:D1="" D
. . . I '$D(^MAGD(2006.575,D0,"RLATE",D1)) D Q
. . . . W:MENU !,"Cross-reference for invalid related entry: """_D1_"""."
. . . . K ^MAGD(2006.575,D0,"RLATE","B",X,D1)
. . . . Q
. . Q
. Q
S LOC="" F S LOC=$O(^MAGD(2006.575,"F",LOC)) Q:LOC="" D
. S V="" F S V=$O(^MAGD(2006.575,"F",LOC,V)) Q:V="" D
. . N I,N,R
. . S N=0,D0="" F S D0=$O(^MAGD(2006.575,"F",LOC,V,D0)) Q:D0="" D
. . . S N=N+1,N(''$D(^MAGD(2006.575,D0,"RLATE")),D0)=""
. . . Q
. . Q:N<2
. . I '$O(N(1,"")) S R=$O(N(0,"")) K N(0,R) S N(1,R)=""
. . S D0=$O(N(1,"")),(L1,N1)=0
. . S D1=0 F S D1=$O(^MAGD(2006.575,D0,"RLATE",D1)) Q:'D1 S L1=D1,N1=N1+1
. . F I=0,1 S N="" F S N=$O(N(I,N)) Q:N="" D:D0'=N
. . . K ^MAGD(2006.575,"F",LOC,V,N)
. . . Q:$D(^MAGD(2006.575,D0,"RLATE","B",N))
. . . S L1=L1+1,N1=N1+1
. . . S ^MAGD(2006.575,D0,"RLATE",L1,0)=N
. . . S ^MAGD(2006.575,D0,"RLATE","B",N,L1)=""
. . . Q
. . S ^MAGD(2006.575,D0,"RLATE",0)="^2006.57526PA^"_L1_"^"_N1
. . Q
. Q
S ^MAGD(2006.575,0)="DICOM FAILED IMAGES^2006.575^"_L0_"^"_N0
L -^MAGD(2006.575)
S OUT=N0
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HMAGDLBV 4249 printed Apr 09, 2024@21:03:05 Page 2
MAGDLBV ;WOIFO/EdM - Validate Table with failed DICOM entries ; 12/16/2004 06:59
+1 ;;3.0;IMAGING;**51**;26-August-2005
+2 ;; +---------------------------------------------------------------+
+3 ;; | Property of the US Government. |
+4 ;; | No permission to copy or redistribute this software is given. |
+5 ;; | Use of unreleased versions of this software requires the user |
+6 ;; | to execute a written test agreement with the VistA Imaging |
+7 ;; | Development Office of the Department of Veterans Affairs, |
+8 ;; | telephone (301) 734-0100. |
+9 ;; | |
+10 ;; | The Food and Drug Administration classifies this software as |
+11 ;; | a medical device. As such, it may not be changed in any way. |
+12 ;; | Modifications to this software may result in an adulterated |
+13 ;; | medical device under 21CFR820, the use of which is considered |
+14 ;; | to be a violation of US Federal Statutes. |
+15 ;; +---------------------------------------------------------------+
+16 ;;
+17 QUIT
+18 ;
+1 WRITE !!,"Starting Validation of data in DICOM Failed Images Table.",!
+2 DO VALIDATE(.OUT,1)
+3 WRITE !!,OUT," entr",$SELECT(OUT=1:"y",1:"ies")," currently in database.",!
+4 QUIT
+5 ;
VALIDATE(OUT,MENU) ; RPC = MAG DICOM CORRECT VALIDATE
+1 NEW D0,D1,FIXED,L0,L1,LOC,N0,N1,TP,V,X
+2 LOCK +^MAGD(2006.575):1E9
+3 SET MENU=+$GET(MENU)
+4 FOR X="AD","AFX","B","D","F"
KILL ^MAGD(2006.575,X)
+5 SET (L0,N0)=0
+6 SET D0=0
FOR
SET D0=$ORDER(^MAGD(2006.575,D0))
if 'D0
QUIT
Begin DoDot:1
+7 SET X=$GET(^MAGD(2006.575,D0,0))
IF X=""
KILL ^MAGD(2006.575,D0)
QUIT
+8 SET L0=D0
SET N0=N0+1
SET (L1,N1)=0
+9 SET FIXED=+$GET(^MAGD(2006.575,D0,"FIXD"))
+10 SET TYPE=$PIECE($GET(^MAGD(2006.575,D0,"TYPE")),"^",1)
+11 SET V=$PIECE(X,"^",1)
if V'=""
SET ^MAGD(2006.575,"B",V,D0)=""
+12 SET V=$PIECE(X,"^",3)
IF V'=""
IF 'FIXED
IF TYPE="CON"
SET ^MAGD(2006.575,"D",V,D0)=""
+13 SET X=$GET(^MAGD(2006.575,D0,1))
SET LOC=$PIECE(X,"^",5)
+14 SET V=$PIECE(X,"^",3)
IF V'=""
IF 'FIXED
IF TYPE="CON"
SET ^MAGD(2006.575,"AD",V,D0)=""
+15 SET FIXED=+$GET(^MAGD(2006.575,D0,"FIXD"))
+16 SET V=$PIECE(X,"^",4)
IF FIXED
IF LOC'=""
IF V'=""
SET ^MAGD(2006.575,"AFX",LOC,V,D0)=""
+17 SET V=$PIECE($GET(^MAGD(2006.575,D0,"ASUID")),"^",1)
+18 IF LOC'=""
IF V'=""
SET ^MAGD(2006.575,"F",LOC,V,D0)=""
+19 SET D1=0
FOR
SET D1=$ORDER(^MAGD(2006.575,D0,"RLATE",D1))
if 'D1
QUIT
Begin DoDot:2
+20 SET X=+$GET(^MAGD(2006.575,D0,"RLATE",D1,0))
+21 IF 'X
Begin DoDot:3
+22 if MENU
WRITE !,"Invalid pointer to related entry: """_X_"""."
+23 KILL ^MAGD(2006.575,D0,"RLATE",D1)
+24 QUIT
End DoDot:3
QUIT
+25 IF '$DATA(^MAGD(2006.575,X))
Begin DoDot:3
+26 if MENU
WRITE !,"Pointer to non-existent related entry: """_X_"""."
+27 KILL ^MAGD(2006.575,D0,"RLATE",D1)
+28 KILL ^MAGD(2006.575,D0,"RLATE","B",X,D1)
+29 QUIT
End DoDot:3
QUIT
+30 SET L1=D1
SET N1=N1+1
+31 QUIT
End DoDot:2
+32 IF 'N1
KILL ^MAGD(2006.575,D0,"RLATE")
QUIT
+33 SET ^MAGD(2006.575,D0,"RLATE",0)="^2006.57526PA^"_L1_"^"_N1
+34 ;
+35 SET X=""
FOR
SET X=$ORDER(^MAGD(2006.575,D0,"RLATE","B",X))
if X=""
QUIT
Begin DoDot:2
+36 IF '$DATA(^MAGD(2006.575,X))
Begin DoDot:3
+37 if MENU
WRITE !,"Cross-reference for non-existent related entry: """_X_"""."
+38 KILL ^MAGD(2006.575,D0,"RLATE","B",X)
+39 QUIT
End DoDot:3
QUIT
+40 SET D1=""
FOR
SET D1=$ORDER(^MAGD(2006.575,D0,"RLATE","B",X,D1))
if D1=""
QUIT
Begin DoDot:3
+41 IF '$DATA(^MAGD(2006.575,D0,"RLATE",D1))
Begin DoDot:4
+42 if MENU
WRITE !,"Cross-reference for invalid related entry: """_D1_"""."
+43 KILL ^MAGD(2006.575,D0,"RLATE","B",X,D1)
+44 QUIT
End DoDot:4
QUIT
End DoDot:3
+45 QUIT
End DoDot:2
+46 QUIT
End DoDot:1
+47 SET LOC=""
FOR
SET LOC=$ORDER(^MAGD(2006.575,"F",LOC))
if LOC=""
QUIT
Begin DoDot:1
+48 SET V=""
FOR
SET V=$ORDER(^MAGD(2006.575,"F",LOC,V))
if V=""
QUIT
Begin DoDot:2
+49 NEW I,N,R
+50 SET N=0
SET D0=""
FOR
SET D0=$ORDER(^MAGD(2006.575,"F",LOC,V,D0))
if D0=""
QUIT
Begin DoDot:3
+51 SET N=N+1
SET N(''$DATA(^MAGD(2006.575,D0,"RLATE")),D0)=""
+52 QUIT
End DoDot:3
+53 if N<2
QUIT
+54 IF '$ORDER(N(1,""))
SET R=$ORDER(N(0,""))
KILL N(0,R)
SET N(1,R)=""
+55 SET D0=$ORDER(N(1,""))
SET (L1,N1)=0
+56 SET D1=0
FOR
SET D1=$ORDER(^MAGD(2006.575,D0,"RLATE",D1))
if 'D1
QUIT
SET L1=D1
SET N1=N1+1
+57 FOR I=0,1
SET N=""
FOR
SET N=$ORDER(N(I,N))
if N=""
QUIT
if D0'=N
Begin DoDot:3
+58 KILL ^MAGD(2006.575,"F",LOC,V,N)
+59 if $DATA(^MAGD(2006.575,D0,"RLATE","B",N))
QUIT
+60 SET L1=L1+1
SET N1=N1+1
+61 SET ^MAGD(2006.575,D0,"RLATE",L1,0)=N
+62 SET ^MAGD(2006.575,D0,"RLATE","B",N,L1)=""
+63 QUIT
End DoDot:3
+64 SET ^MAGD(2006.575,D0,"RLATE",0)="^2006.57526PA^"_L1_"^"_N1
+65 QUIT
End DoDot:2
+66 QUIT
End DoDot:1
+67 SET ^MAGD(2006.575,0)="DICOM FAILED IMAGES^2006.575^"_L0_"^"_N0
+68 LOCK -^MAGD(2006.575)
+69 SET OUT=N0
+70 QUIT
+71 ;
