source: FOIAVistA/tag/r/IMAGING-MAG-ZMAG/MAGGSQI.m@ 636

Last change on this file since 636 was 628, checked in by George Lilly, 14 years ago

initial load of FOIAVistA 6/30/08 version
File size: 8.7 KB
Line 
1MAGGSQI ;WOIFO/GEK ; Image Integrity Checker ; [ 11/08/2001 17:18 ]
2 ;;3.0;IMAGING;**8**;Sep 15, 2004
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 ;;
18RPT(MAGRY,CT,LASTIEN) ; Run the check for the last CT entries in Image file.
19 N I,J,MAGX,ERRCT,ACTCT,TYPECT,MAGSTART,MAGPUR
20 K ^XTMP("MAGCHK")
21 S LASTIEN=$G(LASTIEN)
22 ; See DOCU^MAGCRTP for documenation on this global
23 D NOW^%DTC S MAGSTART=%
24 S X1=%,X2=60 D C^%DTC S MAGPUR=X K X,X1,X2
25 ;Set purge, create and purge date
26 S $P(^XTMP("MAGCHK",$J,0),"^",1)=MAGPUR,$P(^(0),"^",2)=MAGSTART
27 S $P(^XTMP("MAGCHK",$J,0),"^",5)=MAGSTART
28 ;Set description
29 S $P(^XTMP("MAGCHK",$J,0),"^",3)="Imaging Scan DB"
30 ;Set status to active
31 S $P(^XTMP("MAGCHK",$J,0),"^",4)="ACTIVE"
32 S MAGRY(0)="0^Checking..."
33 S I="A"
34 S CT=$G(CT,5000),ERRCT=0,ACTCT=0
35 F S I=$O(^MAG(2005,I),-1) Q:CT<1 Q:'I Q:I<LASTIEN D
36 . S CT=CT-1,ACTCT=ACTCT+1
37 . I '(ACTCT#1000) I IO(0)=IO U IO W "."
38 . K MAGX
39 . D CHK(.MAGX,I)
40 . I +MAGX(0)'=1 S ERRCT=ERRCT+1 D
41 . . S ^XTMP("MAGCHK",$J,+MAGX(0),I)=MAGX(0)
42 . . S ^XTMP("MAGCHK",$J,"B",$P(MAGX(0),"^",2),I)=""
43 . . S TYPECT($P(MAGX(0),"^",2))=$G(TYPECT($P(MAGX(0),"^",2)))+1
44 I 'ERRCT S MAGRY(0)="0^All Okay"
45 I ERRCT S MAGRY(0)=ERRCT_"^Errors of "_ACTCT_" Images Checked."
46 S I="" F S I=$O(TYPECT(I)) Q:I="" D
47 . S MAGRY($O(MAGRY(""),-1)+1)=TYPECT(I)_"^"_I
48 ;Set status to complete
49 S $P(^XTMP("MAGCHK",$J,0),"^",4)="COMPLETE"
50 ;Set end time
51 D NOW^%DTC
52 S $P(^XTMP("MAGCHK",$J,0),"^",6)=%
53 ;Set total number of entries checked
54 S $P(^XTMP("MAGCHK",$J,0),"^",8)=ACTCT
55 Q
56CHK(MAGRY,MAGIEN) ;
57 ;
58 N MAGDFN,MAGPK,MAGPKDA,MAGPKIP,MAGPKDA1,Y,I,MAGISGRP,MAGRPIEN
59 N MAGN2,MAGN0,MAGPDFIL,MAGRCT,MAGDEL,MAGIMG,MAGN100,MAGZ,VALID
60 S MAGRCT=0,MAGISGRP=0
61 ;GEK 01/09/03 Patch 8 : moved the next two lines here. So they are after init of MAGRCT
62 S MAGRY(0)="0^Error during Image Integrity Check !"
63 I 'MAGIEN S MAGRY(MAGRCT)="0^Invalid Image pointer" Q
64 ;
65 S MAGDEL=$D(^MAG(2005.1,MAGIEN))
66 S MAGIMG=$D(^MAG(2005,MAGIEN))
67 I 'MAGIMG,MAGDEL S MAGRY(0)="1^Deleted Image" Q
68 I 'MAGIMG,'MAGDEL S MAGRY(0)="0^Invalid Image pointer" Q
69 I MAGIMG,MAGDEL S MAGRY($O(MAGRY(""),-1)+1)="2^Image IEN exists, and is Deleted !"
70 ;
71 S MAGN0=$G(^MAG(2005,MAGIEN,0))
72 S MAGN2=$G(^MAG(2005,MAGIEN,2))
73 S MAGN100=$G(^MAG(2005,MAGIEN,100))
74 ;
75 I $O(^MAG(2005,MAGIEN,1,0))!($P(MAGN0,U,6)=11) S MAGISGRP=1
76 I MAGISGRP,'$O(^MAG(2005,MAGIEN,1,0)) S MAGRY(0)="0^Group of 0 images" Q
77 ;
78 S MAGPK=$P(MAGN2,U,6)
79 S MAGPKDA=$P(MAGN2,U,7)
80 S MAGPKIP=$P(MAGN2,U,8)
81 S MAGPKDA1=$P(MAGN2,U,10)
82 S MAGDFN=$P(MAGN0,U,7)
83 ;
84 ; If this image is a member of a group, compare some fields against the Group entry.
85 I +$P(MAGN0,U,10) S MAGRPIEN=$P(MAGN0,U,10) D Q
86 . ; Check the DFN's Quit if they don't match
87 . I $P($G(^MAG(2005,MAGRPIEN,0)),U,7)'=MAGDFN S MAGRY(0)="0^Patient pointer mismatch between Image Group and Image" Q
88 . ; if image has data in parent fields, Quit if not same as Group entry.
89 . I +MAGPK,($P(MAGN2,U,6,7)'=$P($G(^MAG(2005,MAGRPIEN,2)),U,6,7)) S MAGRY(MAGRCT)="0^Pointer Mismatch in Group" Q
90 . ;Have a check that assures that the Group has this image in it's multiple
91 . ; ? Do we want to do this when we have the Grp entry, for each of its members. ?
92 . S (I,VALID)=0 F S I=$O(^MAG(2005,MAGRPIEN,1,I)) Q:'I D Q:VALID
93 . . I +^MAG(2005,MAGRPIEN,1,I,0)=MAGIEN S VALID=1
94 . I VALID S MAGRY(MAGRCT)="1^Valid Group image."
95 . E S MAGRY(MAGRCT)="0^Pointer Missing in Group entries."
96 ;
97 ; In current scheme of things, image points to Package or a Descriptive Categroy
98 ; So we can make the following assumption, but maybe not for long.
99 I 'MAGPK,+MAGN100 S MAGRY(MAGRCT)="1^Image Category" Q
100 I 'MAGPK,($P(MAGN0,U,6)=18) S MAGRY(MAGRCT)="1^Patient Photo" Q
101 ;
102 ; Old images Didn't require Parent Pointer,Parent root, Parent Image Pointer
103 ;I 'MAGPK S MAGRY(0)="0^Missing the Parent file pointer" Q
104 ;I 'MAGPKDA S MAGRY(0)="0^Missing the Parent root pointer" Q
105 ;I 'MAGPKIP S MAGRY(0)="0^Missing the Parent image pointer" Q
106 ;
107 ; Surgery reports
108 I (MAGPK=130) D Q
109 . ; Patch. if MAGPK exists, but not a MAGPKDA
110 . I 'MAGPKDA S MAGRY(0)="0^Missing the Parent root pointer" Q
111 . I 'MAGPKIP S MAGRY(0)="0^Missing the Parent image pointer" Q
112 . I '$D(^SRF(MAGPKDA,0)) S MAGRY(0)="0^Invalid Image pointer to associated package report entry" Q
113 . I '$D(^SRF(MAGPKDA,2005,MAGPKIP,0)) S MAGRY="0^Invalid Image pointer in associated package file" Q
114 . I '(MAGDFN=$P(^SRF(MAGPKDA,0),U,1)) S MAGRY(0)="0^Image and associated report have different patient pointers" Q
115 . I '(MAGIEN=+$G(^SRF(MAGPKDA,2005,MAGPKIP,0))) S MAGRY(0)="0^Associated report does not point back to Image" Q
116 . S MAGRY(0)="1^Okay"
117 ;
118 ; TIU documents;
119 I MAGPK=8925 D Q
120 . ; Patch. if MAGPK exists, but not a MAGPKDA
121 . I 'MAGPKDA S MAGRY(0)="0^Missing the Parent root pointer" Q
122 . I 'MAGPKIP S MAGRY(0)="0^Missing the Parent image pointer" Q
123 . I '$D(^TIU(8925,MAGPKDA,0)) S MAGRY(0)="0^Invalid Image pointer to associated package report entry" Q
124 . I '$D(^TIU(8925.91,MAGPKIP,0)) S MAGRY(0)="0^Invalid Image pointer in associated package file" Q
125 . I '(MAGDFN=$P($G(^TIU(8925,MAGPKDA,0)),U,2)) S MAGRY(0)="0^Image and associated report have different patient pointers" Q
126 . S MAGZ=MAGPKDA_"^"_MAGIEN
127 . I '(MAGZ=$G(^TIU(8925.91,MAGPKIP,0))) S MAGRY(0)="0^Associated report does not point back to Image" Q
128 . S MAGRY(0)="1^Okay"
129 ;
130 ; Medicine reports
131 I ((MAGPK>689.999)&(MAGPK<703)) D Q
132 . ; Patch. if MAGPK exists, but not a MAGPKDA
133 . I 'MAGPKDA S MAGRY(0)="0^Missing the Parent root pointer" Q
134 . I '$D(^MCAR(MAGPK,MAGPKDA,0)) S MAGRY(0)="0^Invalid Image pointer to associated package report entry" Q
135 . I MAGPKIP I '$D(^MCAR(MAGPK,MAGPKDA,2005,MAGPKIP,0)) S MAGRY(0)="0^Invalid Image pointer in associated package file" Q
136 . I '(MAGDFN=$P($G(^MCAR(MAGPK,MAGPKDA,0)),U,2)) S MAGRY(0)="0^Image and associated report have different patient pointers" Q
137 . ;I '(MAGIEN=+^MCAR(MAGPK,MAGPKDA,2005,MAGPKIP,0)) S MAGRY(0)="0^Associated report does not point back to Image" Q
138 . I '$D(^MCAR(MAGPK,MAGPKDA,2005,"B",MAGIEN)) S MAGRY(0)="0^Associated report does not point back to Image" Q
139 . S MAGRY(0)="1^Okay"
140 . ;
141 . ; S MCFILE=+$P($P(^MCAR(697.2,PSIEN,0),U,2),"(",2)
142 . ; S PATFLD=$O(^DD(MCFILE,"B","MEDICAL PATIENT",""))
143 . ; S:PATFLD="" PATFLD=1
144 . ;
145 . ; S TMP=$P($P(^DD(MCFILE,PATFLD,0),U,4),";",2)
146 . ; Q $S(DFN'=$P(^MCAR(MCFILE,MCIEN,0),U,TMP):"O^Image and associated report have different patient pointers",1:"1")
147 ;
148 ; Radiology reports
149 I MAGPK=74 D Q
150 . ; Patch. if MAGPK exists, but not a MAGPKDA
151 . I 'MAGPKDA S MAGRY(0)="0^Missing the Parent root pointer" Q
152 . I '$D(^RARPT(MAGPKDA,0)) S MAGRY(0)="0^Invalid Image pointer to associated package report entry" Q
153 . I MAGPKIP I '$D(^RARPT(MAGPKDA,2005,MAGPKIP,0)) S MAGRY(0)="0^Invalid Image pointer in associated package file" Q
154 . ;
155 . I '(MAGDFN=$P($G(^RARPT(MAGPKDA,0)),U,2)) S MAGRY(0)="0^Image and associated report have different patient pointers" Q
156 . ;I '(MAGIEN=+$G(^RARPT(MAGPKDA,2005,MAGPKIP,0))) S MAGRY(0)="0^Associated report does not point back to Image" Q
157 . I '$D(^RARPT(MAGPKDA,2005,"B",MAGIEN)) S MAGRY(0)="0^Associated report does not point back to Image" Q
158 . S MAGRY(0)="1^Okay"
159 ;
160 ; Laboratory reports
161 I (MAGPK>62.999)&(MAGPK<64) D Q
162 . ;I $P(^MAG(2005.03,MAGTMPRT,0),"^",4)=63
163 . S MAGRY(0)="1^Lab image not checked "
164 . ;D @$S(MAGTMPRT=63:"AU",MAGTMPRT=63.2:"AU",1:"LAB") Q
165 ;
166 S MAGRY(0)="2^Images only point to Patient."
167 Q
168CHKGRPCH(CHKY,GRPIEN,GRPDFN,GRPCH) ; Check the child of a Group.
169 ; i.e. an IEN in the "1" node of the Group.
170 ; Can't just check the IEN by calling CHK. It might be okay that way.
171 ; Have to compare it to Groups IEN, and DFN
172 N CHN0
173 S CHN0=$G(^MAG(2005,GRPCH,0)) I '$L(CHN0) S CHKY="0^Invalid Image pointer" Q
174 I $P(CHN0,U,7)'=GRPDFN S CHKY="0^Patient Mismatch in Group member:"_GRPCH Q
175 I $P(CHN0,U,10)'=GRPIEN S CHKY="0^Pointer Mismatch in Group member:"_GRPCH Q
176 S CHKY="1^Okay Group Image"
177 Q
Note: See TracBrowser for help on using the repository browser.