98 lines
4.1 KiB
Mathematica
98 lines
4.1 KiB
Mathematica
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
|
|
;
|
|
MENU ; This entry is called from the VistA menu
|
|
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
|
|
;
|