source: WorldVistAEHR/trunk/r/IMAGING-MAG-ZMAG/MAGDLBV.m@ 701

Last change on this file since 701 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR
File size: 4.1 KB
Line 
1MAGDLBV ;WOIFO/EdM - Validate Table with failed DICOM entries ; 12/16/2004 06:59
2 ;;3.0;IMAGING;**51**;26-August-2005
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 Q
19 ;
20MENU ; This entry is called from the VistA menu
21 W !!,"Starting Validation of data in DICOM Failed Images Table.",!
22 D VALIDATE(.OUT,1)
23 W !!,OUT," entr",$S(OUT=1:"y",1:"ies")," currently in database.",!
24 Q
25 ;
26VALIDATE(OUT,MENU) ; RPC = MAG DICOM CORRECT VALIDATE
27 N D0,D1,FIXED,L0,L1,LOC,N0,N1,TP,V,X
28 L +^MAGD(2006.575):1E9
29 S MENU=+$G(MENU)
30 F X="AD","AFX","B","D","F" K ^MAGD(2006.575,X)
31 S (L0,N0)=0
32 S D0=0 F S D0=$O(^MAGD(2006.575,D0)) Q:'D0 D
33 . S X=$G(^MAGD(2006.575,D0,0)) I X="" K ^MAGD(2006.575,D0) Q
34 . S L0=D0,N0=N0+1,(L1,N1)=0
35 . S FIXED=+$G(^MAGD(2006.575,D0,"FIXD"))
36 . S TYPE=$P($G(^MAGD(2006.575,D0,"TYPE")),"^",1)
37 . S V=$P(X,"^",1) S:V'="" ^MAGD(2006.575,"B",V,D0)=""
38 . S V=$P(X,"^",3) I V'="",'FIXED,TYPE="CON" S ^MAGD(2006.575,"D",V,D0)=""
39 . S X=$G(^MAGD(2006.575,D0,1)),LOC=$P(X,"^",5)
40 . S V=$P(X,"^",3) I V'="",'FIXED,TYPE="CON" S ^MAGD(2006.575,"AD",V,D0)=""
41 . S FIXED=+$G(^MAGD(2006.575,D0,"FIXD"))
42 . S V=$P(X,"^",4) I FIXED,LOC'="",V'="" S ^MAGD(2006.575,"AFX",LOC,V,D0)=""
43 . S V=$P($G(^MAGD(2006.575,D0,"ASUID")),"^",1)
44 . I LOC'="",V'="" S ^MAGD(2006.575,"F",LOC,V,D0)=""
45 . S D1=0 F S D1=$O(^MAGD(2006.575,D0,"RLATE",D1)) Q:'D1 D
46 . . S X=+$G(^MAGD(2006.575,D0,"RLATE",D1,0))
47 . . I 'X D Q
48 . . . W:MENU !,"Invalid pointer to related entry: """_X_"""."
49 . . . K ^MAGD(2006.575,D0,"RLATE",D1)
50 . . . Q
51 . . I '$D(^MAGD(2006.575,X)) D Q
52 . . . W:MENU !,"Pointer to non-existent related entry: """_X_"""."
53 . . . K ^MAGD(2006.575,D0,"RLATE",D1)
54 . . . K ^MAGD(2006.575,D0,"RLATE","B",X,D1)
55 . . . Q
56 . . S L1=D1,N1=N1+1
57 . . Q
58 . I 'N1 K ^MAGD(2006.575,D0,"RLATE") Q
59 . S ^MAGD(2006.575,D0,"RLATE",0)="^2006.57526PA^"_L1_"^"_N1
60 . ;
61 . S X="" F S X=$O(^MAGD(2006.575,D0,"RLATE","B",X)) Q:X="" D
62 . . I '$D(^MAGD(2006.575,X)) D Q
63 . . . W:MENU !,"Cross-reference for non-existent related entry: """_X_"""."
64 . . . K ^MAGD(2006.575,D0,"RLATE","B",X)
65 . . . Q
66 . . S D1="" F S D1=$O(^MAGD(2006.575,D0,"RLATE","B",X,D1)) Q:D1="" D
67 . . . I '$D(^MAGD(2006.575,D0,"RLATE",D1)) D Q
68 . . . . W:MENU !,"Cross-reference for invalid related entry: """_D1_"""."
69 . . . . K ^MAGD(2006.575,D0,"RLATE","B",X,D1)
70 . . . . Q
71 . . Q
72 . Q
73 S LOC="" F S LOC=$O(^MAGD(2006.575,"F",LOC)) Q:LOC="" D
74 . S V="" F S V=$O(^MAGD(2006.575,"F",LOC,V)) Q:V="" D
75 . . N I,N,R
76 . . S N=0,D0="" F S D0=$O(^MAGD(2006.575,"F",LOC,V,D0)) Q:D0="" D
77 . . . S N=N+1,N(''$D(^MAGD(2006.575,D0,"RLATE")),D0)=""
78 . . . Q
79 . . Q:N<2
80 . . I '$O(N(1,"")) S R=$O(N(0,"")) K N(0,R) S N(1,R)=""
81 . . S D0=$O(N(1,"")),(L1,N1)=0
82 . . S D1=0 F S D1=$O(^MAGD(2006.575,D0,"RLATE",D1)) Q:'D1 S L1=D1,N1=N1+1
83 . . F I=0,1 S N="" F S N=$O(N(I,N)) Q:N="" D:D0'=N
84 . . . K ^MAGD(2006.575,"F",LOC,V,N)
85 . . . Q:$D(^MAGD(2006.575,D0,"RLATE","B",N))
86 . . . S L1=L1+1,N1=N1+1
87 . . . S ^MAGD(2006.575,D0,"RLATE",L1,0)=N
88 . . . S ^MAGD(2006.575,D0,"RLATE","B",N,L1)=""
89 . . . Q
90 . . S ^MAGD(2006.575,D0,"RLATE",0)="^2006.57526PA^"_L1_"^"_N1
91 . . Q
92 . Q
93 S ^MAGD(2006.575,0)="DICOM FAILED IMAGES^2006.575^"_L0_"^"_N0
94 L -^MAGD(2006.575)
95 S OUT=N0
96 Q
97 ;
Note: See TracBrowser for help on using the repository browser.