178 lines
8.7 KiB
Mathematica
178 lines
8.7 KiB
Mathematica
MAGGSQI ;WOIFO/GEK ; Image Integrity Checker ; [ 11/08/2001 17:18 ]
|
|
;;3.0;IMAGING;**8**;Sep 15, 2004
|
|
;; +---------------------------------------------------------------+
|
|
;; | 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. |
|
|
;; +---------------------------------------------------------------+
|
|
;;
|
|
RPT(MAGRY,CT,LASTIEN) ; Run the check for the last CT entries in Image file.
|
|
N I,J,MAGX,ERRCT,ACTCT,TYPECT,MAGSTART,MAGPUR
|
|
K ^XTMP("MAGCHK")
|
|
S LASTIEN=$G(LASTIEN)
|
|
; See DOCU^MAGCRTP for documenation on this global
|
|
D NOW^%DTC S MAGSTART=%
|
|
S X1=%,X2=60 D C^%DTC S MAGPUR=X K X,X1,X2
|
|
;Set purge, create and purge date
|
|
S $P(^XTMP("MAGCHK",$J,0),"^",1)=MAGPUR,$P(^(0),"^",2)=MAGSTART
|
|
S $P(^XTMP("MAGCHK",$J,0),"^",5)=MAGSTART
|
|
;Set description
|
|
S $P(^XTMP("MAGCHK",$J,0),"^",3)="Imaging Scan DB"
|
|
;Set status to active
|
|
S $P(^XTMP("MAGCHK",$J,0),"^",4)="ACTIVE"
|
|
S MAGRY(0)="0^Checking..."
|
|
S I="A"
|
|
S CT=$G(CT,5000),ERRCT=0,ACTCT=0
|
|
F S I=$O(^MAG(2005,I),-1) Q:CT<1 Q:'I Q:I<LASTIEN D
|
|
. S CT=CT-1,ACTCT=ACTCT+1
|
|
. I '(ACTCT#1000) I IO(0)=IO U IO W "."
|
|
. K MAGX
|
|
. D CHK(.MAGX,I)
|
|
. I +MAGX(0)'=1 S ERRCT=ERRCT+1 D
|
|
. . S ^XTMP("MAGCHK",$J,+MAGX(0),I)=MAGX(0)
|
|
. . S ^XTMP("MAGCHK",$J,"B",$P(MAGX(0),"^",2),I)=""
|
|
. . S TYPECT($P(MAGX(0),"^",2))=$G(TYPECT($P(MAGX(0),"^",2)))+1
|
|
I 'ERRCT S MAGRY(0)="0^All Okay"
|
|
I ERRCT S MAGRY(0)=ERRCT_"^Errors of "_ACTCT_" Images Checked."
|
|
S I="" F S I=$O(TYPECT(I)) Q:I="" D
|
|
. S MAGRY($O(MAGRY(""),-1)+1)=TYPECT(I)_"^"_I
|
|
;Set status to complete
|
|
S $P(^XTMP("MAGCHK",$J,0),"^",4)="COMPLETE"
|
|
;Set end time
|
|
D NOW^%DTC
|
|
S $P(^XTMP("MAGCHK",$J,0),"^",6)=%
|
|
;Set total number of entries checked
|
|
S $P(^XTMP("MAGCHK",$J,0),"^",8)=ACTCT
|
|
Q
|
|
CHK(MAGRY,MAGIEN) ;
|
|
;
|
|
N MAGDFN,MAGPK,MAGPKDA,MAGPKIP,MAGPKDA1,Y,I,MAGISGRP,MAGRPIEN
|
|
N MAGN2,MAGN0,MAGPDFIL,MAGRCT,MAGDEL,MAGIMG,MAGN100,MAGZ,VALID
|
|
S MAGRCT=0,MAGISGRP=0
|
|
;GEK 01/09/03 Patch 8 : moved the next two lines here. So they are after init of MAGRCT
|
|
S MAGRY(0)="0^Error during Image Integrity Check !"
|
|
I 'MAGIEN S MAGRY(MAGRCT)="0^Invalid Image pointer" Q
|
|
;
|
|
S MAGDEL=$D(^MAG(2005.1,MAGIEN))
|
|
S MAGIMG=$D(^MAG(2005,MAGIEN))
|
|
I 'MAGIMG,MAGDEL S MAGRY(0)="1^Deleted Image" Q
|
|
I 'MAGIMG,'MAGDEL S MAGRY(0)="0^Invalid Image pointer" Q
|
|
I MAGIMG,MAGDEL S MAGRY($O(MAGRY(""),-1)+1)="2^Image IEN exists, and is Deleted !"
|
|
;
|
|
S MAGN0=$G(^MAG(2005,MAGIEN,0))
|
|
S MAGN2=$G(^MAG(2005,MAGIEN,2))
|
|
S MAGN100=$G(^MAG(2005,MAGIEN,100))
|
|
;
|
|
I $O(^MAG(2005,MAGIEN,1,0))!($P(MAGN0,U,6)=11) S MAGISGRP=1
|
|
I MAGISGRP,'$O(^MAG(2005,MAGIEN,1,0)) S MAGRY(0)="0^Group of 0 images" Q
|
|
;
|
|
S MAGPK=$P(MAGN2,U,6)
|
|
S MAGPKDA=$P(MAGN2,U,7)
|
|
S MAGPKIP=$P(MAGN2,U,8)
|
|
S MAGPKDA1=$P(MAGN2,U,10)
|
|
S MAGDFN=$P(MAGN0,U,7)
|
|
;
|
|
; If this image is a member of a group, compare some fields against the Group entry.
|
|
I +$P(MAGN0,U,10) S MAGRPIEN=$P(MAGN0,U,10) D Q
|
|
. ; Check the DFN's Quit if they don't match
|
|
. I $P($G(^MAG(2005,MAGRPIEN,0)),U,7)'=MAGDFN S MAGRY(0)="0^Patient pointer mismatch between Image Group and Image" Q
|
|
. ; if image has data in parent fields, Quit if not same as Group entry.
|
|
. 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
|
|
. ;Have a check that assures that the Group has this image in it's multiple
|
|
. ; ? Do we want to do this when we have the Grp entry, for each of its members. ?
|
|
. S (I,VALID)=0 F S I=$O(^MAG(2005,MAGRPIEN,1,I)) Q:'I D Q:VALID
|
|
. . I +^MAG(2005,MAGRPIEN,1,I,0)=MAGIEN S VALID=1
|
|
. I VALID S MAGRY(MAGRCT)="1^Valid Group image."
|
|
. E S MAGRY(MAGRCT)="0^Pointer Missing in Group entries."
|
|
;
|
|
; In current scheme of things, image points to Package or a Descriptive Categroy
|
|
; So we can make the following assumption, but maybe not for long.
|
|
I 'MAGPK,+MAGN100 S MAGRY(MAGRCT)="1^Image Category" Q
|
|
I 'MAGPK,($P(MAGN0,U,6)=18) S MAGRY(MAGRCT)="1^Patient Photo" Q
|
|
;
|
|
; Old images Didn't require Parent Pointer,Parent root, Parent Image Pointer
|
|
;I 'MAGPK S MAGRY(0)="0^Missing the Parent file pointer" Q
|
|
;I 'MAGPKDA S MAGRY(0)="0^Missing the Parent root pointer" Q
|
|
;I 'MAGPKIP S MAGRY(0)="0^Missing the Parent image pointer" Q
|
|
;
|
|
; Surgery reports
|
|
I (MAGPK=130) D Q
|
|
. ; Patch. if MAGPK exists, but not a MAGPKDA
|
|
. I 'MAGPKDA S MAGRY(0)="0^Missing the Parent root pointer" Q
|
|
. I 'MAGPKIP S MAGRY(0)="0^Missing the Parent image pointer" Q
|
|
. I '$D(^SRF(MAGPKDA,0)) S MAGRY(0)="0^Invalid Image pointer to associated package report entry" Q
|
|
. I '$D(^SRF(MAGPKDA,2005,MAGPKIP,0)) S MAGRY="0^Invalid Image pointer in associated package file" Q
|
|
. I '(MAGDFN=$P(^SRF(MAGPKDA,0),U,1)) S MAGRY(0)="0^Image and associated report have different patient pointers" Q
|
|
. I '(MAGIEN=+$G(^SRF(MAGPKDA,2005,MAGPKIP,0))) S MAGRY(0)="0^Associated report does not point back to Image" Q
|
|
. S MAGRY(0)="1^Okay"
|
|
;
|
|
; TIU documents;
|
|
I MAGPK=8925 D Q
|
|
. ; Patch. if MAGPK exists, but not a MAGPKDA
|
|
. I 'MAGPKDA S MAGRY(0)="0^Missing the Parent root pointer" Q
|
|
. I 'MAGPKIP S MAGRY(0)="0^Missing the Parent image pointer" Q
|
|
. I '$D(^TIU(8925,MAGPKDA,0)) S MAGRY(0)="0^Invalid Image pointer to associated package report entry" Q
|
|
. I '$D(^TIU(8925.91,MAGPKIP,0)) S MAGRY(0)="0^Invalid Image pointer in associated package file" Q
|
|
. I '(MAGDFN=$P($G(^TIU(8925,MAGPKDA,0)),U,2)) S MAGRY(0)="0^Image and associated report have different patient pointers" Q
|
|
. S MAGZ=MAGPKDA_"^"_MAGIEN
|
|
. I '(MAGZ=$G(^TIU(8925.91,MAGPKIP,0))) S MAGRY(0)="0^Associated report does not point back to Image" Q
|
|
. S MAGRY(0)="1^Okay"
|
|
;
|
|
; Medicine reports
|
|
I ((MAGPK>689.999)&(MAGPK<703)) D Q
|
|
. ; Patch. if MAGPK exists, but not a MAGPKDA
|
|
. I 'MAGPKDA S MAGRY(0)="0^Missing the Parent root pointer" Q
|
|
. I '$D(^MCAR(MAGPK,MAGPKDA,0)) S MAGRY(0)="0^Invalid Image pointer to associated package report entry" Q
|
|
. I MAGPKIP I '$D(^MCAR(MAGPK,MAGPKDA,2005,MAGPKIP,0)) S MAGRY(0)="0^Invalid Image pointer in associated package file" Q
|
|
. I '(MAGDFN=$P($G(^MCAR(MAGPK,MAGPKDA,0)),U,2)) S MAGRY(0)="0^Image and associated report have different patient pointers" Q
|
|
. ;I '(MAGIEN=+^MCAR(MAGPK,MAGPKDA,2005,MAGPKIP,0)) S MAGRY(0)="0^Associated report does not point back to Image" Q
|
|
. I '$D(^MCAR(MAGPK,MAGPKDA,2005,"B",MAGIEN)) S MAGRY(0)="0^Associated report does not point back to Image" Q
|
|
. S MAGRY(0)="1^Okay"
|
|
. ;
|
|
. ; S MCFILE=+$P($P(^MCAR(697.2,PSIEN,0),U,2),"(",2)
|
|
. ; S PATFLD=$O(^DD(MCFILE,"B","MEDICAL PATIENT",""))
|
|
. ; S:PATFLD="" PATFLD=1
|
|
. ;
|
|
. ; S TMP=$P($P(^DD(MCFILE,PATFLD,0),U,4),";",2)
|
|
. ; Q $S(DFN'=$P(^MCAR(MCFILE,MCIEN,0),U,TMP):"O^Image and associated report have different patient pointers",1:"1")
|
|
;
|
|
; Radiology reports
|
|
I MAGPK=74 D Q
|
|
. ; Patch. if MAGPK exists, but not a MAGPKDA
|
|
. I 'MAGPKDA S MAGRY(0)="0^Missing the Parent root pointer" Q
|
|
. I '$D(^RARPT(MAGPKDA,0)) S MAGRY(0)="0^Invalid Image pointer to associated package report entry" Q
|
|
. I MAGPKIP I '$D(^RARPT(MAGPKDA,2005,MAGPKIP,0)) S MAGRY(0)="0^Invalid Image pointer in associated package file" Q
|
|
. ;
|
|
. I '(MAGDFN=$P($G(^RARPT(MAGPKDA,0)),U,2)) S MAGRY(0)="0^Image and associated report have different patient pointers" Q
|
|
. ;I '(MAGIEN=+$G(^RARPT(MAGPKDA,2005,MAGPKIP,0))) S MAGRY(0)="0^Associated report does not point back to Image" Q
|
|
. I '$D(^RARPT(MAGPKDA,2005,"B",MAGIEN)) S MAGRY(0)="0^Associated report does not point back to Image" Q
|
|
. S MAGRY(0)="1^Okay"
|
|
;
|
|
; Laboratory reports
|
|
I (MAGPK>62.999)&(MAGPK<64) D Q
|
|
. ;I $P(^MAG(2005.03,MAGTMPRT,0),"^",4)=63
|
|
. S MAGRY(0)="1^Lab image not checked "
|
|
. ;D @$S(MAGTMPRT=63:"AU",MAGTMPRT=63.2:"AU",1:"LAB") Q
|
|
;
|
|
S MAGRY(0)="2^Images only point to Patient."
|
|
Q
|
|
CHKGRPCH(CHKY,GRPIEN,GRPDFN,GRPCH) ; Check the child of a Group.
|
|
; i.e. an IEN in the "1" node of the Group.
|
|
; Can't just check the IEN by calling CHK. It might be okay that way.
|
|
; Have to compare it to Groups IEN, and DFN
|
|
N CHN0
|
|
S CHN0=$G(^MAG(2005,GRPCH,0)) I '$L(CHN0) S CHKY="0^Invalid Image pointer" Q
|
|
I $P(CHN0,U,7)'=GRPDFN S CHKY="0^Patient Mismatch in Group member:"_GRPCH Q
|
|
I $P(CHN0,U,10)'=GRPIEN S CHKY="0^Pointer Mismatch in Group member:"_GRPCH Q
|
|
S CHKY="1^Okay Group Image"
|
|
Q
|