MAGGTIG ;WOIFO/GEK/SG/NST - MAGGT Image Get. Callbacks to Get Image lists ; 14 Sep 2010 10:15 AM
;;3.0;IMAGING;**8,48,93,117,150,151**;Mar 19, 2002;Build 21;Dec 19, 2016
;; 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. |
;; +---------------------------------------------------------------+
;;
Q
GRPCOUNT(MAGRY,MAGIEN) ;
S MAGRY=+$P($G(^MAG(2005,MAGIEN,1,0)),U,4)
Q
IMAGES(MAGRY,MAGDFN) ;RPC [MAGG PAT IMAGES]
; Call to return a list of images for a patient.
; We are returning all images for a patient, Groups are returned
; as one Image.
; The Images are returned in Rev Chronological Order, latest image
; first, oldest image last.
; User can reorder at the workstation level.
K MAGRY
N Y,RDT,PRX,CT,IEN,GBLRET,MAGFILE
N $ETRAP,$ESTACK S $ETRAP="D ERRA^MAGGTERR"
S MAGDFN=+MAGDFN
; if no Images for the patient, then quit.
I '$D(^MAG(2005,"APDTPX",MAGDFN)) S MAGRY(0)="1^0" Q
; the "APDTPX" cross reference is :
; "APDTPX",DFN,Rev Date,Procedure,MAGIEN )
;
; we'll use @ notation, this'll work if an Array or a Global Array is begin returned
S GBLRET=0
S MAGRY="MAGRY"
S CT=0,RDT=""
F S RDT=$O(^MAG(2005,"APDTPX",MAGDFN,RDT)) Q:'RDT D
. S PRX="" F S PRX=$O(^MAG(2005,"APDTPX",MAGDFN,RDT,PRX)) Q:PRX="" D
. . S IEN=""
. . F S IEN=$O(^MAG(2005,"APDTPX",MAGDFN,RDT,PRX,IEN)) Q:'IEN D
. . . Q:$P($G(^MAG(2005,IEN,0)),"^",10) ; CHILD OF GROUP
. . . Q:$$ISDEL^MAGGI11(IEN) ; Deleted image
. . . S CT=CT+1
. . . I (CT>100),'GBLRET D ARY2GLB
. . . S MAGFILE=$$INFO^MAGGAII(IEN,"E")
. . . S @MAGRY@(CT)="B2^"_MAGFILE
S @MAGRY@(0)="1^"_CT
Q
PHOTOS(MAGRY,MAGDFN) ;RPC [MAGG PAT PHOTOS]
; Call to return list of all Photo ID's on file for a patient.
; We are returning all Photo ID images for a patient.
; The Images are returned in Rev Chronological Order, latest image
; first, oldest image last.
;
K MAGRY
N Y,RDT,PRX,CT,IEN,IENS,GBLRET,MAGFILE
N $ETRAP,$ESTACK S $ETRAP="D ERRA^MAGGTERR"
S MAGDFN=+MAGDFN
; if no Photo ID Images for the patient, then quit.
I '$D(^MAG(2005,"APPXDT",MAGDFN,"PHOTO ID")) S MAGRY(0)="1^0" Q
; the "APPXDT" cross reference is :
; "APPXDT",DFN,Procedure,Rev Date,MAGIEN )
;
; we'll use @ notation, this'll work if an Array or a Global Array is begin returned
S GBLRET=0
S MAGRY="MAGRY"
S CT=0
S RDT="" F S RDT=$O(^MAG(2005,"APPXDT",MAGDFN,"PHOTO ID",RDT)) Q:RDT="" D
. S IEN=""
. F S IEN=$O(^MAG(2005,"APPXDT",MAGDFN,"PHOTO ID",RDT,IEN)) Q:'IEN D
. . ;Q:$P($G(^MAG(2005,IEN,0)),"^",10) ; CHILD OF GROUP
. . Q:$$ISDEL^MAGGI11(IEN) ; Deleted image
. . S IENS(IEN)=""
. . Q
. Q
S IEN="" F S IEN=$O(IENS(IEN),-1) Q:'IEN D
. S CT=CT+1
. S MAGFILE=$$INFO^MAGGAII(IEN,"E")
. S @MAGRY@(CT)="B2^"_MAGFILE
. Q
S @MAGRY@(0)="1^"_CT
Q
EACHIMG(MAGRY,MAGDFN,MAX,FLAGS) ;RPC [MAGG PAT EACH IMAGE]
; Call Returns list of recent Patient images.
; MAX = maximum number of images to return
; MAGDFN = patient DFN
; FLAGS = MAGDEV^START IEN ; p150
;
; MAGDEV = [CID] C and/or I and/or D. Null = ALL
; List images that were captured by these Devices.
; C : Capture Application
; I : Import API
; D : DICOM Gateway
; START IEN = the Image IEN to start the search on.
; Patch 151 introduced the option of getting 'more' images added
; to the list in the 'Latest Patient Images' window of capture.
;
; We are returning all images for a patient, and listing each image.
; This is called from Capture Window where groups aren't listed.
; The Images are returned in Rev Chronological Order, latest image
; first, oldest image last.
; User can decide how many of the most recent they want to list.
K MAGRY
N Y,RDT,PRX,CT,IEN,GBLRET
N N0,N2
S FLAGS=$G(FLAGS)
I FLAGS="" S FLAGS="CID"
S MAX=$S($G(MAX)>0:MAX,1:50) ; 50 IS DEFAULT
S MAX=MAX-1
S MAGDEV=$P(FLAGS,"^",1)
S IEN=$P(FLAGS,"^",2)
N $ETRAP,$ESTACK S $ETRAP="D AERRA^MAGGTERR"
S MAGDFN=+MAGDFN
; if no Images for the patient, then quit.
I '$D(^MAG(2005,"AC",MAGDFN)) S MAGRY(0)="1^0" Q
; the "AC" cross reference is :
; "AC",DFN,IEN )
;
; we'll use @ notation, this'll work if an Array or a Global Array is begin returned
S GBLRET=0
S MAGRY="MAGRY"
S CT=0
F S IEN=$O(^MAG(2005,"AC",MAGDFN,IEN),-1) Q:'IEN D Q:(CT>MAX)
. Q:$P($G(^MAG(2005,IEN,0)),U,6)=11 ; NOT LISTING GROUP ENTRIES
. Q:$$ISDEL^MAGGI11(IEN) ; Skip deleted images
. S N2=$G(^MAG(2005,IEN,2))
. Q:MAGDEV'[$P(N2,"^",12)
. S CT=CT+1
. I (CT>100),'GBLRET D ARY2GLB
. S @MAGRY@(CT)=$$CAPINFO(IEN)
S @MAGRY@(0)="1^"_CT
Q
CAPINFO(IEN) ; RETURN A STRING OF INFORMATION ABOUT THE IMAGE
; This is for Capture App
N RETY,N2,PN2,X,MAGFILE,GPAR
;
S MAGFILE=$$INFO^MAGGAII(IEN,"E")
S RETY=$P(MAGFILE,U,1,7)_U
S N2=$G(^MAG(2005,IEN,2))
S N0=$G(^MAG(2005,IEN,0))
S RETY=RETY_$$FMTE^XLFDT($P(N2,U,1),"5P")_U
S X=$P(RETY,U,5),X=$$FMTE^XLFDT(X,"5"),X=$P(X,"@")
S $P(RETY,U,5)=X
S $P(RETY,U,9)=$P(N2,"^",12) ; NEW FOR P151 Capture Application
S GPAR=$P(N0,"^",10) ; NEW FOR P151 T4 Group Parent
S $P(RETY,U,10)=GPAR
; P151 T2 show Note Title if Note
I $P($G(N2),"^",6)=8925 S $P(RETY,"^",7)=$$TITLE($P(N2,"^",7))
I GPAR]"" D ; P151T4 if Group, check Group TITLE
. S PN2=$G(^MAG(2005,GPAR,2))
. I $P($G(PN2),"^",6)=8925 S $P(RETY,"^",7)=$$TITLE($P(PN2,"^",7))
Q RETY
Q
TITLE(TIUDA) ; Return TIU Note TITLE
N TITLE,TIUDAT
I '(+$G(TIUDA)) Q " - Note Title ? - "
D DATA^MAGGNTI(.TIUDAT,TIUDA)
S TITLE=$P(TIUDAT,"^",2)
I TITLE="" S TITLE=" - Note Title ? - "
Q TITLE
;
ARY2GLB ; Image count is getting big, switch from array to Global return type
S GBLRET=1
K ^TMP("MAGGTIG",$J)
S MAGRY=""
M ^TMP("MAGGTIG",$J)=MAGRY
K MAGRY
S X=$$RTRNFMT^XWBLIB("GLOBAL ARRAY",1)
S MAGRY=$NA(^TMP("MAGGTIG",$J))
Q
GROUP(MAGRY,MAGIEN,NOCHK,FLAGS) ;RPC [MAGG GROUP IMAGES]
; CalL to Return image list of a Group.
; MAGIEN = the entry in MAG(2005 we assume it is a group.
; NOCHK = flag - Do (or) Not Do QI Check.
N Y,MAGDFN,I,MAGCHILD,MAGCT,MAGTMPAR,MSGX,MAGQI,MAGY,MAGFILE
N MAGNOCHK
S FLAGS=$G(FLAGS)
;Test BigGroup S BKG=+$G(BKG)
;Test BigGroup K ^TMP("MAGBGRP")
S MAGIEN=+MAGIEN,MSGX=""
S NOCHK=+$G(NOCHK)
I '$D(^MAG(2005,MAGIEN,0)) S MAGRY(0)="0^ERROR: Image entry "_MAGIEN_" Doesn't exist" Q
I $O(^MAG(2005,MAGIEN,1,0))="" S MAGRY(0)="0^ERROR: There are NO Images defined for this Group" Q
;
; we'll use @ notation, this'll work if an Array or a Global Array is being returned
S MAGRY="MAGRY"
;
; if we are switching to a Global Array because too many images,
; then set MAGRY and clean it up first
;I +$P($G(^MAG(2005,MAGIEN,1,0)),U,4)>100
D
. S X=$$RTRNFMT^XWBLIB("GLOBAL ARRAY",1)
. S MAGRY=$NA(^TMP("MAGGTIG",$J))
. K @MAGRY
N $ETRAP,$ESTACK S $ETRAP="D ERRA^MAGGTERR"
;
;Test BigGroup I $D(^TMP("MAGBGRP",MAGIEN)) D Q
;Test BigGroup . M ^TMP("MAGGTIG",$J)=^TMP("MAGBGRP",MAGIEN)
;Test BigGroup . Q
; integrity check, stop if group entry is questionable
; NOCHK is sent from Image Delete window (so user with DELETE and SYSTEM keys)
; can see group abstracts before the group is deleted.
I 'NOCHK D CHK^MAGGSQI(.MAGQI,MAGIEN) I 'MAGQI(0) D Q
. S @MAGRY@(0)=MAGQI(0)
;
S MAGNOCHK=1
S I=0,MAGCT=0,MAGDFN=$P(^MAG(2005,MAGIEN,0),"^",7)
I $D(^MAG(2005,MAGIEN,1,"ADCM")) D
. N INUM,SNUM
. S INUM="" ; GEK 4/3/00 changed Q:'INUM to Q:INUM="" below
. F S INUM=$O(^MAG(2005,MAGIEN,1,"ADCM",INUM)) Q:INUM="" D
. . S SNUM=""
. . F S SNUM=$O(^MAG(2005,MAGIEN,1,"ADCM",INUM,SNUM)) Q:SNUM="" D
. . . S MAGCHILD=""
. . . F S MAGCHILD=$O(^MAG(2005,MAGIEN,1,"ADCM",INUM,SNUM,MAGCHILD)) Q:'MAGCHILD D
. . . . S MAGCT=MAGCT+1
. . . . I '$D(^MAG(2005,MAGCHILD)) D INVALID(MAGCHILD,.MSGX) S @MAGRY@(MAGCT)=MSGX Q
. . . . ; Added for MAGQI integrity check
. . . . K MAGY
. . . . D CHKGRPCH^MAGGSQI(.MAGY,MAGIEN,MAGDFN,MAGCHILD) I 'MAGY D INVCH(.MAGY,MAGCHILD) S @MAGRY@(MAGCT)=MAGY Q
. . . . S MAGTMPAR(MAGCHILD)=""
. . . . S MAGFILE=$$INFO^MAGGAII(MAGCHILD,"E")
. . . . S $P(MAGFILE,U,12,13)=INUM_U_SNUM
. . . . S @MAGRY@(MAGCT)="B2^"_MAGFILE
. . . . ;Test BigGroup I 'BKG S @MAGRY@(MAGCT)="B2^"_MAGFILE
. . . . ;Test BigGroup E S ^TMP("MAGBGRP",MAGIEN,MAGCT)="B2^"_MAGFILE
;GEK 4/8/99 MODIFIED, because now we have groups, that some entries
; have dicom numbers and some don't. So we have to go through the group again.
;Test BigGroup - Need a Pre/Post init, that fixes Groups where some entries have Dicom values, and some
; don't. In such a group, we will make Dicom values for the images that don't have them.
; Testing in Washington - this will take hours.
;
S I=0
F S I=$O(^MAG(2005,MAGIEN,1,I)) Q:'I D
. S MAGCHILD=+^MAG(2005,MAGIEN,1,I,0)
. I $D(MAGTMPAR(MAGCHILD)) Q
. S MAGCT=MAGCT+1
. I '$D(^MAG(2005,MAGCHILD)) D INVALID(MAGCHILD,.MSGX) S @MAGRY@(MAGCT)=MSGX Q
. ;Added for MAGQI integrity check
. K MAGY
. D CHKGRPCH^MAGGSQI(.MAGY,MAGIEN,MAGDFN,MAGCHILD) I 'MAGY D INVCH(.MAGY,MAGCHILD) S @MAGRY@(MAGCT)=MAGY Q
. S MAGFILE=$$INFO^MAGGAII(MAGCHILD,"E")
. S @MAGRY@(MAGCT)="B2^"_MAGFILE
. ;Test BigGroup I 'BKG S @MAGRY@(MAGCT)="B2^"_MAGFILE
. ;Test BigGroup E S ^TMP("MAGBGRP",MAGIEN,MAGCT)="B2^"_MAGFILE
I FLAGS["D" D ; Patch 117
. ; Get Deleted images
. S MAGCHILD=0
. F S MAGCHILD=$O(^MAG(2005.1,"AGP",MAGIEN,MAGCHILD)) Q:'MAGCHILD D
. . I ($P(^MAG(2005.1,MAGCHILD,100),"^",8)=13) Q ;p150 If ImageNeverExisted Quit.
. . S MAGCT=MAGCT+1
. . S MAGFILE=$$INFO^MAGGAII(MAGCHILD,"D")
. . S @MAGRY@(MAGCT)="B2^"_MAGFILE
. . Q
S @MAGRY@(0)="1^"_MAGCT
Q
INVALID(MAGX,MAGZ) ;
;
I $$ISDEL^MAGGI11(MAGX) S MAGZ="B2^"_MAGX_"^^^INVALID Reference to Deleted Image^^66^^^^^^^^"
E S MAGZ="B2^"_MAGX_"^^^INVALID Image ID (IEN)^^67^^^^^^^^"
;Added with MAGQI integrity check,
S MAGTMPAR(MAGX)=""
Q
INVCH(MSG,CHILD) ;Added for MAGQI integrity check
; MSG is passed by reference, we create a MAGFILE equivalent and pass it back.
N EMSG
S EMSG=$P(MSG,U,2)
K MSG
S $P(MSG,U)=CHILD
; remove dependency on c:\program files. with .\bmp\
S $P(MSG,U,2,3)="-1~Questionable Data Integrity^.\bmp\imageQA.bmp"
S $P(MSG,U,4)=$P($G(^MAG(2005,CHILD,2)),U,4)
S $P(MSG,U,6)=$S(($P(MSG,U,6)'=11):"99",1:11)
;this stops Delphi App from changing Abstract BMP to OFFLINE IMAGE
S $P(MSG,U,10)="M"
;Send the error message
S $P(MSG,U,17)=EMSG
S MSG="B2^"_MSG
S MAGTMPAR(CHILD)=""
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HMAGGTIG 11606 printed Apr 09, 2024@21:06:07 Page 2
MAGGTIG ;WOIFO/GEK/SG/NST - MAGGT Image Get. Callbacks to Get Image lists ; 14 Sep 2010 10:15 AM
+1 ;;3.0;IMAGING;**8,48,93,117,150,151**;Mar 19, 2002;Build 21;Dec 19, 2016
+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 ;;
+17 QUIT
GRPCOUNT(MAGRY,MAGIEN) ;
+1 SET MAGRY=+$PIECE($GET(^MAG(2005,MAGIEN,1,0)),U,4)
+2 QUIT
IMAGES(MAGRY,MAGDFN) ;RPC [MAGG PAT IMAGES]
+1 ; Call to return a list of images for a patient.
+2 ; We are returning all images for a patient, Groups are returned
+3 ; as one Image.
+4 ; The Images are returned in Rev Chronological Order, latest image
+5 ; first, oldest image last.
+6 ; User can reorder at the workstation level.
+7 KILL MAGRY
+8 NEW Y,RDT,PRX,CT,IEN,GBLRET,MAGFILE
+9 NEW $ETRAP,$ESTACK
SET $ETRAP="D ERRA^MAGGTERR"
+10 SET MAGDFN=+MAGDFN
+11 ; if no Images for the patient, then quit.
+12 IF '$DATA(^MAG(2005,"APDTPX",MAGDFN))
SET MAGRY(0)="1^0"
QUIT
+13 ; the "APDTPX" cross reference is :
+14 ; "APDTPX",DFN,Rev Date,Procedure,MAGIEN )
+15 ;
+16 ; we'll use @ notation, this'll work if an Array or a Global Array is begin returned
+17 SET GBLRET=0
+18 SET MAGRY="MAGRY"
+19 SET CT=0
SET RDT=""
+20 FOR
SET RDT=$ORDER(^MAG(2005,"APDTPX",MAGDFN,RDT))
if 'RDT
QUIT
Begin DoDot:1
+21 SET PRX=""
FOR
SET PRX=$ORDER(^MAG(2005,"APDTPX",MAGDFN,RDT,PRX))
if PRX=""
QUIT
Begin DoDot:2
+22 SET IEN=""
+23 FOR
SET IEN=$ORDER(^MAG(2005,"APDTPX",MAGDFN,RDT,PRX,IEN))
if 'IEN
QUIT
Begin DoDot:3
+24 ; CHILD OF GROUP
if $PIECE($GET(^MAG(2005,IEN,0)),"^",10)
QUIT
+25 ; Deleted image
if $$ISDEL^MAGGI11(IEN)
QUIT
+26 SET CT=CT+1
+27 IF (CT>100)
IF 'GBLRET
DO ARY2GLB
+28 SET MAGFILE=$$INFO^MAGGAII(IEN,"E")
+29 SET @MAGRY@(CT)="B2^"_MAGFILE
End DoDot:3
End DoDot:2
End DoDot:1
+30 SET @MAGRY@(0)="1^"_CT
+31 QUIT
PHOTOS(MAGRY,MAGDFN) ;RPC [MAGG PAT PHOTOS]
+1 ; Call to return list of all Photo ID's on file for a patient.
+2 ; We are returning all Photo ID images for a patient.
+3 ; The Images are returned in Rev Chronological Order, latest image
+4 ; first, oldest image last.
+5 ;
+6 KILL MAGRY
+7 NEW Y,RDT,PRX,CT,IEN,IENS,GBLRET,MAGFILE
+8 NEW $ETRAP,$ESTACK
SET $ETRAP="D ERRA^MAGGTERR"
+9 SET MAGDFN=+MAGDFN
+10 ; if no Photo ID Images for the patient, then quit.
+11 IF '$DATA(^MAG(2005,"APPXDT",MAGDFN,"PHOTO ID"))
SET MAGRY(0)="1^0"
QUIT
+12 ; the "APPXDT" cross reference is :
+13 ; "APPXDT",DFN,Procedure,Rev Date,MAGIEN )
+14 ;
+15 ; we'll use @ notation, this'll work if an Array or a Global Array is begin returned
+16 SET GBLRET=0
+17 SET MAGRY="MAGRY"
+18 SET CT=0
+19 SET RDT=""
FOR
SET RDT=$ORDER(^MAG(2005,"APPXDT",MAGDFN,"PHOTO ID",RDT))
if RDT=""
QUIT
Begin DoDot:1
+20 SET IEN=""
+21 FOR
SET IEN=$ORDER(^MAG(2005,"APPXDT",MAGDFN,"PHOTO ID",RDT,IEN))
if 'IEN
QUIT
Begin DoDot:2
+22 ;Q:$P($G(^MAG(2005,IEN,0)),"^",10) ; CHILD OF GROUP
+23 ; Deleted image
if $$ISDEL^MAGGI11(IEN)
QUIT
+24 SET IENS(IEN)=""
+25 QUIT
End DoDot:2
+26 QUIT
End DoDot:1
+27 SET IEN=""
FOR
SET IEN=$ORDER(IENS(IEN),-1)
if 'IEN
QUIT
Begin DoDot:1
+28 SET CT=CT+1
+29 SET MAGFILE=$$INFO^MAGGAII(IEN,"E")
+30 SET @MAGRY@(CT)="B2^"_MAGFILE
+31 QUIT
End DoDot:1
+32 SET @MAGRY@(0)="1^"_CT
+33 QUIT
EACHIMG(MAGRY,MAGDFN,MAX,FLAGS) ;RPC [MAGG PAT EACH IMAGE]
+1 ; Call Returns list of recent Patient images.
+2 ; MAX = maximum number of images to return
+3 ; MAGDFN = patient DFN
+4 ; FLAGS = MAGDEV^START IEN ; p150
+5 ;
+6 ; MAGDEV = [CID] C and/or I and/or D. Null = ALL
+7 ; List images that were captured by these Devices.
+8 ; C : Capture Application
+9 ; I : Import API
+10 ; D : DICOM Gateway
+11 ; START IEN = the Image IEN to start the search on.
+12 ; Patch 151 introduced the option of getting 'more' images added
+13 ; to the list in the 'Latest Patient Images' window of capture.
+14 ;
+15 ; We are returning all images for a patient, and listing each image.
+16 ; This is called from Capture Window where groups aren't listed.
+17 ; The Images are returned in Rev Chronological Order, latest image
+18 ; first, oldest image last.
+19 ; User can decide how many of the most recent they want to list.
+20 KILL MAGRY
+21 NEW Y,RDT,PRX,CT,IEN,GBLRET
+22 NEW N0,N2
+23 SET FLAGS=$GET(FLAGS)
+24 IF FLAGS=""
SET FLAGS="CID"
+25 ; 50 IS DEFAULT
SET MAX=$SELECT($GET(MAX)>0:MAX,1:50)
+26 SET MAX=MAX-1
+27 SET MAGDEV=$PIECE(FLAGS,"^",1)
+28 SET IEN=$PIECE(FLAGS,"^",2)
+29 NEW $ETRAP,$ESTACK
SET $ETRAP="D AERRA^MAGGTERR"
+30 SET MAGDFN=+MAGDFN
+31 ; if no Images for the patient, then quit.
+32 IF '$DATA(^MAG(2005,"AC",MAGDFN))
SET MAGRY(0)="1^0"
QUIT
+33 ; the "AC" cross reference is :
+34 ; "AC",DFN,IEN )
+35 ;
+36 ; we'll use @ notation, this'll work if an Array or a Global Array is begin returned
+37 SET GBLRET=0
+38 SET MAGRY="MAGRY"
+39 SET CT=0
+40 FOR
SET IEN=$ORDER(^MAG(2005,"AC",MAGDFN,IEN),-1)
if 'IEN
QUIT
Begin DoDot:1
+41 ; NOT LISTING GROUP ENTRIES
if $PIECE($GET(^MAG(2005,IEN,0)),U,6)=11
QUIT
+42 ; Skip deleted images
if $$ISDEL^MAGGI11(IEN)
QUIT
+43 SET N2=$GET(^MAG(2005,IEN,2))
+44 if MAGDEV'[$PIECE(N2,"^",12)
QUIT
+45 SET CT=CT+1
+46 IF (CT>100)
IF 'GBLRET
DO ARY2GLB
+47 SET @MAGRY@(CT)=$$CAPINFO(IEN)
End DoDot:1
if (CT>MAX)
QUIT
+48 SET @MAGRY@(0)="1^"_CT
+49 QUIT
CAPINFO(IEN) ; RETURN A STRING OF INFORMATION ABOUT THE IMAGE
+1 ; This is for Capture App
+2 NEW RETY,N2,PN2,X,MAGFILE,GPAR
+3 ;
+4 SET MAGFILE=$$INFO^MAGGAII(IEN,"E")
+5 SET RETY=$PIECE(MAGFILE,U,1,7)_U
+6 SET N2=$GET(^MAG(2005,IEN,2))
+7 SET N0=$GET(^MAG(2005,IEN,0))
+8 SET RETY=RETY_$$FMTE^XLFDT($PIECE(N2,U,1),"5P")_U
+9 SET X=$PIECE(RETY,U,5)
SET X=$$FMTE^XLFDT(X,"5")
SET X=$PIECE(X,"@")
+10 SET $PIECE(RETY,U,5)=X
+11 ; NEW FOR P151 Capture Application
SET $PIECE(RETY,U,9)=$PIECE(N2,"^",12)
+12 ; NEW FOR P151 T4 Group Parent
SET GPAR=$PIECE(N0,"^",10)
+13 SET $PIECE(RETY,U,10)=GPAR
+14 ; P151 T2 show Note Title if Note
+15 IF $PIECE($GET(N2),"^",6)=8925
SET $PIECE(RETY,"^",7)=$$TITLE($PIECE(N2,"^",7))
+16 ; P151T4 if Group, check Group TITLE
IF GPAR]""
Begin DoDot:1
+17 SET PN2=$GET(^MAG(2005,GPAR,2))
+18 IF $PIECE($GET(PN2),"^",6)=8925
SET $PIECE(RETY,"^",7)=$$TITLE($PIECE(PN2,"^",7))
End DoDot:1
+19 QUIT RETY
+20 QUIT
TITLE(TIUDA) ; Return TIU Note TITLE
+1 NEW TITLE,TIUDAT
+2 IF '(+$GET(TIUDA))
QUIT " - Note Title ? - "
+3 DO DATA^MAGGNTI(.TIUDAT,TIUDA)
+4 SET TITLE=$PIECE(TIUDAT,"^",2)
+5 IF TITLE=""
SET TITLE=" - Note Title ? - "
+6 QUIT TITLE
+7 ;
ARY2GLB ; Image count is getting big, switch from array to Global return type
+1 SET GBLRET=1
+2 KILL ^TMP("MAGGTIG",$JOB)
+3 SET MAGRY=""
+4 MERGE ^TMP("MAGGTIG",$JOB)=MAGRY
+5 KILL MAGRY
+6 SET X=$$RTRNFMT^XWBLIB("GLOBAL ARRAY",1)
+7 SET MAGRY=$NAME(^TMP("MAGGTIG",$JOB))
+8 QUIT
GROUP(MAGRY,MAGIEN,NOCHK,FLAGS) ;RPC [MAGG GROUP IMAGES]
+1 ; CalL to Return image list of a Group.
+2 ; MAGIEN = the entry in MAG(2005 we assume it is a group.
+3 ; NOCHK = flag - Do (or) Not Do QI Check.
+4 NEW Y,MAGDFN,I,MAGCHILD,MAGCT,MAGTMPAR,MSGX,MAGQI,MAGY,MAGFILE
+5 NEW MAGNOCHK
+6 SET FLAGS=$GET(FLAGS)
+7 ;Test BigGroup S BKG=+$G(BKG)
+8 ;Test BigGroup K ^TMP("MAGBGRP")
+9 SET MAGIEN=+MAGIEN
SET MSGX=""
+10 SET NOCHK=+$GET(NOCHK)
+11 IF '$DATA(^MAG(2005,MAGIEN,0))
SET MAGRY(0)="0^ERROR: Image entry "_MAGIEN_" Doesn't exist"
QUIT
+12 IF $ORDER(^MAG(2005,MAGIEN,1,0))=""
SET MAGRY(0)="0^ERROR: There are NO Images defined for this Group"
QUIT
+13 ;
+14 ; we'll use @ notation, this'll work if an Array or a Global Array is being returned
+15 SET MAGRY="MAGRY"
+16 ;
+17 ; if we are switching to a Global Array because too many images,
+18 ; then set MAGRY and clean it up first
+19 ;I +$P($G(^MAG(2005,MAGIEN,1,0)),U,4)>100
+20 Begin DoDot:1
+21 SET X=$$RTRNFMT^XWBLIB("GLOBAL ARRAY",1)
+22 SET MAGRY=$NAME(^TMP("MAGGTIG",$JOB))
+23 KILL @MAGRY
End DoDot:1
+24 NEW $ETRAP,$ESTACK
SET $ETRAP="D ERRA^MAGGTERR"
+25 ;
+26 ;Test BigGroup I $D(^TMP("MAGBGRP",MAGIEN)) D Q
+27 ;Test BigGroup . M ^TMP("MAGGTIG",$J)=^TMP("MAGBGRP",MAGIEN)
+28 ;Test BigGroup . Q
+29 ; integrity check, stop if group entry is questionable
+30 ; NOCHK is sent from Image Delete window (so user with DELETE and SYSTEM keys)
+31 ; can see group abstracts before the group is deleted.
+32 IF 'NOCHK
DO CHK^MAGGSQI(.MAGQI,MAGIEN)
IF 'MAGQI(0)
Begin DoDot:1
+33 SET @MAGRY@(0)=MAGQI(0)
End DoDot:1
QUIT
+34 ;
+35 SET MAGNOCHK=1
+36 SET I=0
SET MAGCT=0
SET MAGDFN=$PIECE(^MAG(2005,MAGIEN,0),"^",7)
+37 IF $DATA(^MAG(2005,MAGIEN,1,"ADCM"))
Begin DoDot:1
+38 NEW INUM,SNUM
+39 ; GEK 4/3/00 changed Q:'INUM to Q:INUM="" below
SET INUM=""
+40 FOR
SET INUM=$ORDER(^MAG(2005,MAGIEN,1,"ADCM",INUM))
if INUM=""
QUIT
Begin DoDot:2
+41 SET SNUM=""
+42 FOR
SET SNUM=$ORDER(^MAG(2005,MAGIEN,1,"ADCM",INUM,SNUM))
if SNUM=""
QUIT
Begin DoDot:3
+43 SET MAGCHILD=""
+44 FOR
SET MAGCHILD=$ORDER(^MAG(2005,MAGIEN,1,"ADCM",INUM,SNUM,MAGCHILD))
if 'MAGCHILD
QUIT
Begin DoDot:4
+45 SET MAGCT=MAGCT+1
+46 IF '$DATA(^MAG(2005,MAGCHILD))
DO INVALID(MAGCHILD,.MSGX)
SET @MAGRY@(MAGCT)=MSGX
QUIT
+47 ; Added for MAGQI integrity check
+48 KILL MAGY
+49 DO CHKGRPCH^MAGGSQI(.MAGY,MAGIEN,MAGDFN,MAGCHILD)
IF 'MAGY
DO INVCH(.MAGY,MAGCHILD)
SET @MAGRY@(MAGCT)=MAGY
QUIT
+50 SET MAGTMPAR(MAGCHILD)=""
+51 SET MAGFILE=$$INFO^MAGGAII(MAGCHILD,"E")
+52 SET $PIECE(MAGFILE,U,12,13)=INUM_U_SNUM
+53 SET @MAGRY@(MAGCT)="B2^"_MAGFILE
+54 ;Test BigGroup I 'BKG S @MAGRY@(MAGCT)="B2^"_MAGFILE
+55 ;Test BigGroup E S ^TMP("MAGBGRP",MAGIEN,MAGCT)="B2^"_MAGFILE
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+56 ;GEK 4/8/99 MODIFIED, because now we have groups, that some entries
+57 ; have dicom numbers and some don't. So we have to go through the group again.
+58 ;Test BigGroup - Need a Pre/Post init, that fixes Groups where some entries have Dicom values, and some
+59 ; don't. In such a group, we will make Dicom values for the images that don't have them.
+60 ; Testing in Washington - this will take hours.
+61 ;
+62 SET I=0
+63 FOR
SET I=$ORDER(^MAG(2005,MAGIEN,1,I))
if 'I
QUIT
Begin DoDot:1
+64 SET MAGCHILD=+^MAG(2005,MAGIEN,1,I,0)
+65 IF $DATA(MAGTMPAR(MAGCHILD))
QUIT
+66 SET MAGCT=MAGCT+1
+67 IF '$DATA(^MAG(2005,MAGCHILD))
DO INVALID(MAGCHILD,.MSGX)
SET @MAGRY@(MAGCT)=MSGX
QUIT
+68 ;Added for MAGQI integrity check
+69 KILL MAGY
+70 DO CHKGRPCH^MAGGSQI(.MAGY,MAGIEN,MAGDFN,MAGCHILD)
IF 'MAGY
DO INVCH(.MAGY,MAGCHILD)
SET @MAGRY@(MAGCT)=MAGY
QUIT
+71 SET MAGFILE=$$INFO^MAGGAII(MAGCHILD,"E")
+72 SET @MAGRY@(MAGCT)="B2^"_MAGFILE
+73 ;Test BigGroup I 'BKG S @MAGRY@(MAGCT)="B2^"_MAGFILE
+74 ;Test BigGroup E S ^TMP("MAGBGRP",MAGIEN,MAGCT)="B2^"_MAGFILE
End DoDot:1
+75 ; Patch 117
IF FLAGS["D"
Begin DoDot:1
+76 ; Get Deleted images
+77 SET MAGCHILD=0
+78 FOR
SET MAGCHILD=$ORDER(^MAG(2005.1,"AGP",MAGIEN,MAGCHILD))
if 'MAGCHILD
QUIT
Begin DoDot:2
+79 ;p150 If ImageNeverExisted Quit.
IF ($PIECE(^MAG(2005.1,MAGCHILD,100),"^",8)=13)
QUIT
+80 SET MAGCT=MAGCT+1
+81 SET MAGFILE=$$INFO^MAGGAII(MAGCHILD,"D")
+82 SET @MAGRY@(MAGCT)="B2^"_MAGFILE
+83 QUIT
End DoDot:2
End DoDot:1
+84 SET @MAGRY@(0)="1^"_MAGCT
+85 QUIT
INVALID(MAGX,MAGZ) ;
+1 ;
+2 IF $$ISDEL^MAGGI11(MAGX)
SET MAGZ="B2^"_MAGX_"^^^INVALID Reference to Deleted Image^^66^^^^^^^^"
+3 IF '$TEST
SET MAGZ="B2^"_MAGX_"^^^INVALID Image ID (IEN)^^67^^^^^^^^"
+4 ;Added with MAGQI integrity check,
+5 SET MAGTMPAR(MAGX)=""
+6 QUIT
INVCH(MSG,CHILD) ;Added for MAGQI integrity check
+1 ; MSG is passed by reference, we create a MAGFILE equivalent and pass it back.
+2 NEW EMSG
+3 SET EMSG=$PIECE(MSG,U,2)
+4 KILL MSG
+5 SET $PIECE(MSG,U)=CHILD
+6 ; remove dependency on c:\program files. with .\bmp\
+7 SET $PIECE(MSG,U,2,3)="-1~Questionable Data Integrity^.\bmp\imageQA.bmp"
+8 SET $PIECE(MSG,U,4)=$PIECE($GET(^MAG(2005,CHILD,2)),U,4)
+9 SET $PIECE(MSG,U,6)=$SELECT(($PIECE(MSG,U,6)'=11):"99",1:11)
+10 ;this stops Delphi App from changing Abstract BMP to OFFLINE IMAGE
+11 SET $PIECE(MSG,U,10)="M"
+12 ;Send the error message
+13 SET $PIECE(MSG,U,17)=EMSG
+14 SET MSG="B2^"_MSG
+15 SET MAGTMPAR(CHILD)=""
+16 QUIT
