MAGGSQI ;WOIFO/GEK/SG - Image Integrity Checker ; 18 Jul 2013 5:15 PM
;;3.0;IMAGING;**8,93,138**;Mar 19, 2002;Build 5380;Sep 03, 2013
;; Per VHA Directive 2004-038, this routine should not be modified.
;; +---------------------------------------------------------------+
;; | 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^MAGCRPT 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
. Q:$$ISDEL^MAGGI11(I)
. 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 ERR,MAGDFN,MAGPK,MAGPKDA,MAGPKIP,MAGPKDA1,Y,I,MAGISGRP,MAGRPIEN
N MAGN2,MAGN0,MAGPDFIL,MAGRCT,MAGN100,MAGZ,VALID
S MAGRCT=0,MAGISGRP=0
S MAGRY(0)="0^Error during Image Integrity Check !"
;
I $$ISDEL^MAGGI11(MAGIEN,.ERR) S MAGRY(0)="1^Deleted Image" Q
I ERR<0 D Q:ERR<0
. I +ERR=-43 D Q
. . S ERR=0,I=$O(MAGRY(""),-1)+1
. . S MAGRY(I)="2^Image IEN exists, and is Deleted !"
. . Q
. S MAGRY(0)="0^Invalid Image pointer"
. Q
;
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
;
; DICOM temporary file for consults and anatomic pathology
I (MAGPK=2006.5838)!(MAGPK=2006.5839) D Q
. S MAGRY(0)="1^DICOM temp image not checked "
. 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
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HMAGGSQI 9156 printed Apr 09, 2024@21:11:20 Page 2
MAGGSQI ;WOIFO/GEK/SG - Image Integrity Checker ; 18 Jul 2013 5:15 PM
+1 ;;3.0;IMAGING;**8,93,138**;Mar 19, 2002;Build 5380;Sep 03, 2013
+2 ;; Per VHA Directive 2004-038, this routine should not be modified.
+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 ;; | 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 ;;
RPT(MAGRY,CT,LASTIEN) ; Run the check for the last CT entries in Image file.
+1 NEW I,J,MAGX,ERRCT,ACTCT,TYPECT,MAGSTART,MAGPUR
+2 KILL ^XTMP("MAGCHK")
+3 SET LASTIEN=$GET(LASTIEN)
+4 ; See DOCU^MAGCRPT for documenation on this global
+5 DO NOW^%DTC
SET MAGSTART=%
+6 SET X1=%
SET X2=60
DO C^%DTC
SET MAGPUR=X
KILL X,X1,X2
+7 ;Set purge, create and purge date
+8 SET $PIECE(^XTMP("MAGCHK",$JOB,0),"^",1)=MAGPUR
SET $PIECE(^(0),"^",2)=MAGSTART
+9 SET $PIECE(^XTMP("MAGCHK",$JOB,0),"^",5)=MAGSTART
+10 ;Set description
+11 SET $PIECE(^XTMP("MAGCHK",$JOB,0),"^",3)="Imaging Scan DB"
+12 ;Set status to active
+13 SET $PIECE(^XTMP("MAGCHK",$JOB,0),"^",4)="ACTIVE"
+14 SET MAGRY(0)="0^Checking..."
+15 SET I="A"
+16 SET CT=$GET(CT,5000)
SET ERRCT=0
SET ACTCT=0
+17 FOR
SET I=$ORDER(^MAG(2005,I),-1)
if CT<1
QUIT
if 'I
QUIT
if I<LASTIEN
QUIT
Begin DoDot:1
+18 if $$ISDEL^MAGGI11(I)
QUIT
+19 SET CT=CT-1
SET ACTCT=ACTCT+1
+20 IF '(ACTCT#1000)
IF IO(0)=IO
USE IO
WRITE "."
+21 KILL MAGX
+22 DO CHK(.MAGX,I)
+23 IF +MAGX(0)'=1
SET ERRCT=ERRCT+1
Begin DoDot:2
+24 SET ^XTMP("MAGCHK",$JOB,+MAGX(0),I)=MAGX(0)
+25 SET ^XTMP("MAGCHK",$JOB,"B",$PIECE(MAGX(0),"^",2),I)=""
+26 SET TYPECT($PIECE(MAGX(0),"^",2))=$GET(TYPECT($PIECE(MAGX(0),"^",2)))+1
End DoDot:2
End DoDot:1
+27 IF 'ERRCT
SET MAGRY(0)="0^All Okay"
+28 IF ERRCT
SET MAGRY(0)=ERRCT_"^Errors of "_ACTCT_" Images Checked."
+29 SET I=""
FOR
SET I=$ORDER(TYPECT(I))
if I=""
QUIT
Begin DoDot:1
+30 SET MAGRY($ORDER(MAGRY(""),-1)+1)=TYPECT(I)_"^"_I
End DoDot:1
+31 ;Set status to complete
+32 SET $PIECE(^XTMP("MAGCHK",$JOB,0),"^",4)="COMPLETE"
+33 ;Set end time
+34 DO NOW^%DTC
+35 SET $PIECE(^XTMP("MAGCHK",$JOB,0),"^",6)=%
+36 ;Set total number of entries checked
+37 SET $PIECE(^XTMP("MAGCHK",$JOB,0),"^",8)=ACTCT
+38 QUIT
CHK(MAGRY,MAGIEN) ;
+1 ;
+2 NEW ERR,MAGDFN,MAGPK,MAGPKDA,MAGPKIP,MAGPKDA1,Y,I,MAGISGRP,MAGRPIEN
+3 NEW MAGN2,MAGN0,MAGPDFIL,MAGRCT,MAGN100,MAGZ,VALID
+4 SET MAGRCT=0
SET MAGISGRP=0
+5 SET MAGRY(0)="0^Error during Image Integrity Check !"
+6 ;
+7 IF $$ISDEL^MAGGI11(MAGIEN,.ERR)
SET MAGRY(0)="1^Deleted Image"
QUIT
+8 IF ERR<0
Begin DoDot:1
+9 IF +ERR=-43
Begin DoDot:2
+10 SET ERR=0
SET I=$ORDER(MAGRY(""),-1)+1
+11 SET MAGRY(I)="2^Image IEN exists, and is Deleted !"
+12 QUIT
End DoDot:2
QUIT
+13 SET MAGRY(0)="0^Invalid Image pointer"
+14 QUIT
End DoDot:1
if ERR<0
QUIT
+15 ;
+16 SET MAGN0=$GET(^MAG(2005,MAGIEN,0))
+17 SET MAGN2=$GET(^MAG(2005,MAGIEN,2))
+18 SET MAGN100=$GET(^MAG(2005,MAGIEN,100))
+19 ;
+20 IF $ORDER(^MAG(2005,MAGIEN,1,0))!($PIECE(MAGN0,U,6)=11)
SET MAGISGRP=1
+21 IF MAGISGRP
IF '$ORDER(^MAG(2005,MAGIEN,1,0))
SET MAGRY(0)="0^Group of 0 images"
QUIT
+22 ;
+23 SET MAGPK=$PIECE(MAGN2,U,6)
+24 SET MAGPKDA=$PIECE(MAGN2,U,7)
+25 SET MAGPKIP=$PIECE(MAGN2,U,8)
+26 SET MAGPKDA1=$PIECE(MAGN2,U,10)
+27 SET MAGDFN=$PIECE(MAGN0,U,7)
+28 ;
+29 ; If this image is a member of a group, compare some fields against the Group entry.
+30 IF +$PIECE(MAGN0,U,10)
SET MAGRPIEN=$PIECE(MAGN0,U,10)
Begin DoDot:1
+31 ; Check the DFN's Quit if they don't match
+32 IF $PIECE($GET(^MAG(2005,MAGRPIEN,0)),U,7)'=MAGDFN
SET MAGRY(0)="0^Patient pointer mismatch between Image Group and Image"
QUIT
+33 ; if image has data in parent fields, Quit if not same as Group entry.
+34 IF +MAGPK
IF ($PIECE(MAGN2,U,6,7)'=$PIECE($GET(^MAG(2005,MAGRPIEN,2)),U,6,7))
SET MAGRY(MAGRCT)="0^Pointer Mismatch in Group"
QUIT
+35 ;Have a check that assures that the Group has this image in it's multiple
+36 ; ? Do we want to do this when we have the Grp entry, for each of its members. ?
+37 SET (I,VALID)=0
FOR
SET I=$ORDER(^MAG(2005,MAGRPIEN,1,I))
if 'I
QUIT
Begin DoDot:2
+38 IF +^MAG(2005,MAGRPIEN,1,I,0)=MAGIEN
SET VALID=1
End DoDot:2
if VALID
QUIT
+39 IF VALID
SET MAGRY(MAGRCT)="1^Valid Group image."
+40 IF '$TEST
SET MAGRY(MAGRCT)="0^Pointer Missing in Group entries."
End DoDot:1
QUIT
+41 ;
+42 ; In current scheme of things, image points to Package or a Descriptive Categroy
+43 ; So we can make the following assumption, but maybe not for long.
+44 IF 'MAGPK
IF +MAGN100
SET MAGRY(MAGRCT)="1^Image Category"
QUIT
+45 IF 'MAGPK
IF ($PIECE(MAGN0,U,6)=18)
SET MAGRY(MAGRCT)="1^Patient Photo"
QUIT
+46 ;
+47 ; Old images Didn't require Parent Pointer,Parent root, Parent Image Pointer
+48 ;I 'MAGPK S MAGRY(0)="0^Missing the Parent file pointer" Q
+49 ;I 'MAGPKDA S MAGRY(0)="0^Missing the Parent root pointer" Q
+50 ;I 'MAGPKIP S MAGRY(0)="0^Missing the Parent image pointer" Q
+51 ;
+52 ; Surgery reports
+53 IF (MAGPK=130)
Begin DoDot:1
+54 ; Patch. if MAGPK exists, but not a MAGPKDA
+55 IF 'MAGPKDA
SET MAGRY(0)="0^Missing the Parent root pointer"
QUIT
+56 IF 'MAGPKIP
SET MAGRY(0)="0^Missing the Parent image pointer"
QUIT
+57 IF '$DATA(^SRF(MAGPKDA,0))
SET MAGRY(0)="0^Invalid Image pointer to associated package report entry"
QUIT
+58 IF '$DATA(^SRF(MAGPKDA,2005,MAGPKIP,0))
SET MAGRY="0^Invalid Image pointer in associated package file"
QUIT
+59 IF '(MAGDFN=$PIECE(^SRF(MAGPKDA,0),U,1))
SET MAGRY(0)="0^Image and associated report have different patient pointers"
QUIT
+60 IF '(MAGIEN=+$GET(^SRF(MAGPKDA,2005,MAGPKIP,0)))
SET MAGRY(0)="0^Associated report does not point back to Image"
QUIT
+61 SET MAGRY(0)="1^Okay"
End DoDot:1
QUIT
+62 ;
+63 ; TIU documents;
+64 IF MAGPK=8925
Begin DoDot:1
+65 ; Patch. if MAGPK exists, but not a MAGPKDA
+66 IF 'MAGPKDA
SET MAGRY(0)="0^Missing the Parent root pointer"
QUIT
+67 IF 'MAGPKIP
SET MAGRY(0)="0^Missing the Parent image pointer"
QUIT
+68 IF '$DATA(^TIU(8925,MAGPKDA,0))
SET MAGRY(0)="0^Invalid Image pointer to associated package report entry"
QUIT
+69 IF '$DATA(^TIU(8925.91,MAGPKIP,0))
SET MAGRY(0)="0^Invalid Image pointer in associated package file"
QUIT
+70 IF '(MAGDFN=$PIECE($GET(^TIU(8925,MAGPKDA,0)),U,2))
SET MAGRY(0)="0^Image and associated report have different patient pointers"
QUIT
+71 SET MAGZ=MAGPKDA_"^"_MAGIEN
+72 IF '(MAGZ=$GET(^TIU(8925.91,MAGPKIP,0)))
SET MAGRY(0)="0^Associated report does not point back to Image"
QUIT
+73 SET MAGRY(0)="1^Okay"
End DoDot:1
QUIT
+74 ;
+75 ; Medicine reports
+76 IF ((MAGPK>689.999)&(MAGPK<703))
Begin DoDot:1
+77 ; Patch. if MAGPK exists, but not a MAGPKDA
+78 IF 'MAGPKDA
SET MAGRY(0)="0^Missing the Parent root pointer"
QUIT
+79 IF '$DATA(^MCAR(MAGPK,MAGPKDA,0))
SET MAGRY(0)="0^Invalid Image pointer to associated package report entry"
QUIT
+80 IF MAGPKIP
IF '$DATA(^MCAR(MAGPK,MAGPKDA,2005,MAGPKIP,0))
SET MAGRY(0)="0^Invalid Image pointer in associated package file"
QUIT
+81 IF '(MAGDFN=$PIECE($GET(^MCAR(MAGPK,MAGPKDA,0)),U,2))
SET MAGRY(0)="0^Image and associated report have different patient pointers"
QUIT
+82 ;I '(MAGIEN=+^MCAR(MAGPK,MAGPKDA,2005,MAGPKIP,0)) S MAGRY(0)="0^Associated report does not point back to Image" Q
+83 IF '$DATA(^MCAR(MAGPK,MAGPKDA,2005,"B",MAGIEN))
SET MAGRY(0)="0^Associated report does not point back to Image"
QUIT
+84 SET MAGRY(0)="1^Okay"
+85 ;
+86 ; S MCFILE=+$P($P(^MCAR(697.2,PSIEN,0),U,2),"(",2)
+87 ; S PATFLD=$O(^DD(MCFILE,"B","MEDICAL PATIENT",""))
+88 ; S:PATFLD="" PATFLD=1
+89 ;
+90 ; S TMP=$P($P(^DD(MCFILE,PATFLD,0),U,4),";",2)
+91 ; Q $S(DFN'=$P(^MCAR(MCFILE,MCIEN,0),U,TMP):"O^Image and associated report have different patient pointers",1:"1")
End DoDot:1
QUIT
+92 ;
+93 ; Radiology reports
+94 IF MAGPK=74
Begin DoDot:1
+95 ; Patch. if MAGPK exists, but not a MAGPKDA
+96 IF 'MAGPKDA
SET MAGRY(0)="0^Missing the Parent root pointer"
QUIT
+97 IF '$DATA(^RARPT(MAGPKDA,0))
SET MAGRY(0)="0^Invalid Image pointer to associated package report entry"
QUIT
+98 IF MAGPKIP
IF '$DATA(^RARPT(MAGPKDA,2005,MAGPKIP,0))
SET MAGRY(0)="0^Invalid Image pointer in associated package file"
QUIT
+99 ;
+100 IF '(MAGDFN=$PIECE($GET(^RARPT(MAGPKDA,0)),U,2))
SET MAGRY(0)="0^Image and associated report have different patient pointers"
QUIT
+101 ;I '(MAGIEN=+$G(^RARPT(MAGPKDA,2005,MAGPKIP,0))) S MAGRY(0)="0^Associated report does not point back to Image" Q
+102 IF '$DATA(^RARPT(MAGPKDA,2005,"B",MAGIEN))
SET MAGRY(0)="0^Associated report does not point back to Image"
QUIT
+103 SET MAGRY(0)="1^Okay"
End DoDot:1
QUIT
+104 ;
+105 ; Laboratory reports
+106 IF (MAGPK>62.999)&(MAGPK<64)
Begin DoDot:1
+107 ;I $P(^MAG(2005.03,MAGTMPRT,0),"^",4)=63
+108 SET MAGRY(0)="1^Lab image not checked "
+109 ;D @$S(MAGTMPRT=63:"AU",MAGTMPRT=63.2:"AU",1:"LAB") Q
End DoDot:1
QUIT
+110 ;
+111 ; DICOM temporary file for consults and anatomic pathology
+112 IF (MAGPK=2006.5838)!(MAGPK=2006.5839)
Begin DoDot:1
+113 SET MAGRY(0)="1^DICOM temp image not checked "
+114 QUIT
End DoDot:1
QUIT
+115 ;
+116 SET MAGRY(0)="2^Images only point to Patient."
+117 QUIT
CHKGRPCH(CHKY,GRPIEN,GRPDFN,GRPCH) ; Check the child of a Group.
+1 ; i.e. an IEN in the "1" node of the Group.
+2 ; Can't just check the IEN by calling CHK. It might be okay that way.
+3 ; Have to compare it to Groups IEN, and DFN
+4 NEW CHN0
+5 SET CHN0=$GET(^MAG(2005,GRPCH,0))
IF '$LENGTH(CHN0)
SET CHKY="0^Invalid Image pointer"
QUIT
+6 IF $PIECE(CHN0,U,7)'=GRPDFN
SET CHKY="0^Patient Mismatch in Group member:"_GRPCH
QUIT
+7 IF $PIECE(CHN0,U,10)'=GRPIEN
SET CHKY="0^Pointer Mismatch in Group member:"_GRPCH
QUIT
+8 SET CHKY="1^Okay Group Image"
+9 QUIT
