- 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 Feb 18, 2025@23:29: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