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