Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: MAGGTIG

MAGGTIG.m

Go to the documentation of this file.
  1. 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
  1. ;; Per VHA Directive 2004-038, this routine should not be modified.
  1. ;; +---------------------------------------------------------------+
  1. ;; | Property of the US Government. |
  1. ;; | No permission to copy or redistribute this software is given. |
  1. ;; | Use of unreleased versions of this software requires the user |
  1. ;; | to execute a written test agreement with the VistA Imaging |
  1. ;; | Development Office of the Department of Veterans Affairs, |
  1. ;; | telephone (301) 734-0100. |
  1. ;; | The Food and Drug Administration classifies this software as |
  1. ;; | a medical device. As such, it may not be changed in any way. |
  1. ;; | Modifications to this software may result in an adulterated |
  1. ;; | medical device under 21CFR820, the use of which is considered |
  1. ;; | to be a violation of US Federal Statutes. |
  1. ;; +---------------------------------------------------------------+
  1. ;;
  1. Q
  1. GRPCOUNT(MAGRY,MAGIEN) ;
  1. S MAGRY=+$P($G(^MAG(2005,MAGIEN,1,0)),U,4)
  1. Q
  1. IMAGES(MAGRY,MAGDFN) ;RPC [MAGG PAT IMAGES]
  1. ; Call to return a list of images for a patient.
  1. ; We are returning all images for a patient, Groups are returned
  1. ; as one Image.
  1. ; The Images are returned in Rev Chronological Order, latest image
  1. ; first, oldest image last.
  1. ; User can reorder at the workstation level.
  1. K MAGRY
  1. N Y,RDT,PRX,CT,IEN,GBLRET,MAGFILE
  1. N $ETRAP,$ESTACK S $ETRAP="D ERRA^MAGGTERR"
  1. S MAGDFN=+MAGDFN
  1. ; if no Images for the patient, then quit.
  1. I '$D(^MAG(2005,"APDTPX",MAGDFN)) S MAGRY(0)="1^0" Q
  1. ; the "APDTPX" cross reference is :
  1. ; "APDTPX",DFN,Rev Date,Procedure,MAGIEN )
  1. ;
  1. ; we'll use @ notation, this'll work if an Array or a Global Array is begin returned
  1. S GBLRET=0
  1. S MAGRY="MAGRY"
  1. S CT=0,RDT=""
  1. F S RDT=$O(^MAG(2005,"APDTPX",MAGDFN,RDT)) Q:'RDT D
  1. . S PRX="" F S PRX=$O(^MAG(2005,"APDTPX",MAGDFN,RDT,PRX)) Q:PRX="" D
  1. . . S IEN=""
  1. . . F S IEN=$O(^MAG(2005,"APDTPX",MAGDFN,RDT,PRX,IEN)) Q:'IEN D
  1. . . . Q:$P($G(^MAG(2005,IEN,0)),"^",10) ; CHILD OF GROUP
  1. . . . Q:$$ISDEL^MAGGI11(IEN) ; Deleted image
  1. . . . S CT=CT+1
  1. . . . I (CT>100),'GBLRET D ARY2GLB
  1. . . . S MAGFILE=$$INFO^MAGGAII(IEN,"E")
  1. . . . S @MAGRY@(CT)="B2^"_MAGFILE
  1. S @MAGRY@(0)="1^"_CT
  1. Q
  1. PHOTOS(MAGRY,MAGDFN) ;RPC [MAGG PAT PHOTOS]
  1. ; Call to return list of all Photo ID's on file for a patient.
  1. ; We are returning all Photo ID images for a patient.
  1. ; The Images are returned in Rev Chronological Order, latest image
  1. ; first, oldest image last.
  1. ;
  1. K MAGRY
  1. N Y,RDT,PRX,CT,IEN,IENS,GBLRET,MAGFILE
  1. N $ETRAP,$ESTACK S $ETRAP="D ERRA^MAGGTERR"
  1. S MAGDFN=+MAGDFN
  1. ; if no Photo ID Images for the patient, then quit.
  1. I '$D(^MAG(2005,"APPXDT",MAGDFN,"PHOTO ID")) S MAGRY(0)="1^0" Q
  1. ; the "APPXDT" cross reference is :
  1. ; "APPXDT",DFN,Procedure,Rev Date,MAGIEN )
  1. ;
  1. ; we'll use @ notation, this'll work if an Array or a Global Array is begin returned
  1. S GBLRET=0
  1. S MAGRY="MAGRY"
  1. S CT=0
  1. S RDT="" F S RDT=$O(^MAG(2005,"APPXDT",MAGDFN,"PHOTO ID",RDT)) Q:RDT="" D
  1. . S IEN=""
  1. . F S IEN=$O(^MAG(2005,"APPXDT",MAGDFN,"PHOTO ID",RDT,IEN)) Q:'IEN D
  1. . . ;Q:$P($G(^MAG(2005,IEN,0)),"^",10) ; CHILD OF GROUP
  1. . . Q:$$ISDEL^MAGGI11(IEN) ; Deleted image
  1. . . S IENS(IEN)=""
  1. . . Q
  1. . Q
  1. S IEN="" F S IEN=$O(IENS(IEN),-1) Q:'IEN D
  1. . S CT=CT+1
  1. . S MAGFILE=$$INFO^MAGGAII(IEN,"E")
  1. . S @MAGRY@(CT)="B2^"_MAGFILE
  1. . Q
  1. S @MAGRY@(0)="1^"_CT
  1. Q
  1. EACHIMG(MAGRY,MAGDFN,MAX,FLAGS) ;RPC [MAGG PAT EACH IMAGE]
  1. ; Call Returns list of recent Patient images.
  1. ; MAX = maximum number of images to return
  1. ; MAGDFN = patient DFN
  1. ; FLAGS = MAGDEV^START IEN ; p150
  1. ;
  1. ; MAGDEV = [CID] C and/or I and/or D. Null = ALL
  1. ; List images that were captured by these Devices.
  1. ; C : Capture Application
  1. ; I : Import API
  1. ; D : DICOM Gateway
  1. ; START IEN = the Image IEN to start the search on.
  1. ; Patch 151 introduced the option of getting 'more' images added
  1. ; to the list in the 'Latest Patient Images' window of capture.
  1. ;
  1. ; We are returning all images for a patient, and listing each image.
  1. ; This is called from Capture Window where groups aren't listed.
  1. ; The Images are returned in Rev Chronological Order, latest image
  1. ; first, oldest image last.
  1. ; User can decide how many of the most recent they want to list.
  1. K MAGRY
  1. N Y,RDT,PRX,CT,IEN,GBLRET
  1. N N0,N2
  1. S FLAGS=$G(FLAGS)
  1. I FLAGS="" S FLAGS="CID"
  1. S MAX=$S($G(MAX)>0:MAX,1:50) ; 50 IS DEFAULT
  1. S MAX=MAX-1
  1. S MAGDEV=$P(FLAGS,"^",1)
  1. S IEN=$P(FLAGS,"^",2)
  1. N $ETRAP,$ESTACK S $ETRAP="D AERRA^MAGGTERR"
  1. S MAGDFN=+MAGDFN
  1. ; if no Images for the patient, then quit.
  1. I '$D(^MAG(2005,"AC",MAGDFN)) S MAGRY(0)="1^0" Q
  1. ; the "AC" cross reference is :
  1. ; "AC",DFN,IEN )
  1. ;
  1. ; we'll use @ notation, this'll work if an Array or a Global Array is begin returned
  1. S GBLRET=0
  1. S MAGRY="MAGRY"
  1. S CT=0
  1. F S IEN=$O(^MAG(2005,"AC",MAGDFN,IEN),-1) Q:'IEN D Q:(CT>MAX)
  1. . Q:$P($G(^MAG(2005,IEN,0)),U,6)=11 ; NOT LISTING GROUP ENTRIES
  1. . Q:$$ISDEL^MAGGI11(IEN) ; Skip deleted images
  1. . S N2=$G(^MAG(2005,IEN,2))
  1. . Q:MAGDEV'[$P(N2,"^",12)
  1. . S CT=CT+1
  1. . I (CT>100),'GBLRET D ARY2GLB
  1. . S @MAGRY@(CT)=$$CAPINFO(IEN)
  1. S @MAGRY@(0)="1^"_CT
  1. Q
  1. CAPINFO(IEN) ; RETURN A STRING OF INFORMATION ABOUT THE IMAGE
  1. ; This is for Capture App
  1. N RETY,N2,PN2,X,MAGFILE,GPAR
  1. ;
  1. S MAGFILE=$$INFO^MAGGAII(IEN,"E")
  1. S RETY=$P(MAGFILE,U,1,7)_U
  1. S N2=$G(^MAG(2005,IEN,2))
  1. S N0=$G(^MAG(2005,IEN,0))
  1. S RETY=RETY_$$FMTE^XLFDT($P(N2,U,1),"5P")_U
  1. S X=$P(RETY,U,5),X=$$FMTE^XLFDT(X,"5"),X=$P(X,"@")
  1. S $P(RETY,U,5)=X
  1. S $P(RETY,U,9)=$P(N2,"^",12) ; NEW FOR P151 Capture Application
  1. S GPAR=$P(N0,"^",10) ; NEW FOR P151 T4 Group Parent
  1. S $P(RETY,U,10)=GPAR
  1. ; P151 T2 show Note Title if Note
  1. I $P($G(N2),"^",6)=8925 S $P(RETY,"^",7)=$$TITLE($P(N2,"^",7))
  1. I GPAR]"" D ; P151T4 if Group, check Group TITLE
  1. . S PN2=$G(^MAG(2005,GPAR,2))
  1. . I $P($G(PN2),"^",6)=8925 S $P(RETY,"^",7)=$$TITLE($P(PN2,"^",7))
  1. Q RETY
  1. Q
  1. TITLE(TIUDA) ; Return TIU Note TITLE
  1. N TITLE,TIUDAT
  1. I '(+$G(TIUDA)) Q " - Note Title ? - "
  1. D DATA^MAGGNTI(.TIUDAT,TIUDA)
  1. S TITLE=$P(TIUDAT,"^",2)
  1. I TITLE="" S TITLE=" - Note Title ? - "
  1. Q TITLE
  1. ;
  1. ARY2GLB ; Image count is getting big, switch from array to Global return type
  1. S GBLRET=1
  1. K ^TMP("MAGGTIG",$J)
  1. S MAGRY=""
  1. M ^TMP("MAGGTIG",$J)=MAGRY
  1. K MAGRY
  1. S X=$$RTRNFMT^XWBLIB("GLOBAL ARRAY",1)
  1. S MAGRY=$NA(^TMP("MAGGTIG",$J))
  1. Q
  1. GROUP(MAGRY,MAGIEN,NOCHK,FLAGS) ;RPC [MAGG GROUP IMAGES]
  1. ; CalL to Return image list of a Group.
  1. ; MAGIEN = the entry in MAG(2005 we assume it is a group.
  1. ; NOCHK = flag - Do (or) Not Do QI Check.
  1. N Y,MAGDFN,I,MAGCHILD,MAGCT,MAGTMPAR,MSGX,MAGQI,MAGY,MAGFILE
  1. N MAGNOCHK
  1. S FLAGS=$G(FLAGS)
  1. ;Test BigGroup S BKG=+$G(BKG)
  1. ;Test BigGroup K ^TMP("MAGBGRP")
  1. S MAGIEN=+MAGIEN,MSGX=""
  1. S NOCHK=+$G(NOCHK)
  1. I '$D(^MAG(2005,MAGIEN,0)) S MAGRY(0)="0^ERROR: Image entry "_MAGIEN_" Doesn't exist" Q
  1. I $O(^MAG(2005,MAGIEN,1,0))="" S MAGRY(0)="0^ERROR: There are NO Images defined for this Group" Q
  1. ;
  1. ; we'll use @ notation, this'll work if an Array or a Global Array is being returned
  1. S MAGRY="MAGRY"
  1. ;
  1. ; if we are switching to a Global Array because too many images,
  1. ; then set MAGRY and clean it up first
  1. ;I +$P($G(^MAG(2005,MAGIEN,1,0)),U,4)>100
  1. D
  1. . S X=$$RTRNFMT^XWBLIB("GLOBAL ARRAY",1)
  1. . S MAGRY=$NA(^TMP("MAGGTIG",$J))
  1. . K @MAGRY
  1. N $ETRAP,$ESTACK S $ETRAP="D ERRA^MAGGTERR"
  1. ;
  1. ;Test BigGroup I $D(^TMP("MAGBGRP",MAGIEN)) D Q
  1. ;Test BigGroup . M ^TMP("MAGGTIG",$J)=^TMP("MAGBGRP",MAGIEN)
  1. ;Test BigGroup . Q
  1. ; integrity check, stop if group entry is questionable
  1. ; NOCHK is sent from Image Delete window (so user with DELETE and SYSTEM keys)
  1. ; can see group abstracts before the group is deleted.
  1. I 'NOCHK D CHK^MAGGSQI(.MAGQI,MAGIEN) I 'MAGQI(0) D Q
  1. . S @MAGRY@(0)=MAGQI(0)
  1. ;
  1. S MAGNOCHK=1
  1. S I=0,MAGCT=0,MAGDFN=$P(^MAG(2005,MAGIEN,0),"^",7)
  1. I $D(^MAG(2005,MAGIEN,1,"ADCM")) D
  1. . N INUM,SNUM
  1. . S INUM="" ; GEK 4/3/00 changed Q:'INUM to Q:INUM="" below
  1. . F S INUM=$O(^MAG(2005,MAGIEN,1,"ADCM",INUM)) Q:INUM="" D
  1. . . S SNUM=""
  1. . . F S SNUM=$O(^MAG(2005,MAGIEN,1,"ADCM",INUM,SNUM)) Q:SNUM="" D
  1. . . . S MAGCHILD=""
  1. . . . F S MAGCHILD=$O(^MAG(2005,MAGIEN,1,"ADCM",INUM,SNUM,MAGCHILD)) Q:'MAGCHILD D
  1. . . . . S MAGCT=MAGCT+1
  1. . . . . I '$D(^MAG(2005,MAGCHILD)) D INVALID(MAGCHILD,.MSGX) S @MAGRY@(MAGCT)=MSGX Q
  1. . . . . ; Added for MAGQI integrity check
  1. . . . . K MAGY
  1. . . . . D CHKGRPCH^MAGGSQI(.MAGY,MAGIEN,MAGDFN,MAGCHILD) I 'MAGY D INVCH(.MAGY,MAGCHILD) S @MAGRY@(MAGCT)=MAGY Q
  1. . . . . S MAGTMPAR(MAGCHILD)=""
  1. . . . . S MAGFILE=$$INFO^MAGGAII(MAGCHILD,"E")
  1. . . . . S $P(MAGFILE,U,12,13)=INUM_U_SNUM
  1. . . . . S @MAGRY@(MAGCT)="B2^"_MAGFILE
  1. . . . . ;Test BigGroup I 'BKG S @MAGRY@(MAGCT)="B2^"_MAGFILE
  1. . . . . ;Test BigGroup E S ^TMP("MAGBGRP",MAGIEN,MAGCT)="B2^"_MAGFILE
  1. ;GEK 4/8/99 MODIFIED, because now we have groups, that some entries
  1. ; have dicom numbers and some don't. So we have to go through the group again.
  1. ;Test BigGroup - Need a Pre/Post init, that fixes Groups where some entries have Dicom values, and some
  1. ; don't. In such a group, we will make Dicom values for the images that don't have them.
  1. ; Testing in Washington - this will take hours.
  1. ;
  1. S I=0
  1. F S I=$O(^MAG(2005,MAGIEN,1,I)) Q:'I D
  1. . S MAGCHILD=+^MAG(2005,MAGIEN,1,I,0)
  1. . I $D(MAGTMPAR(MAGCHILD)) Q
  1. . S MAGCT=MAGCT+1
  1. . I '$D(^MAG(2005,MAGCHILD)) D INVALID(MAGCHILD,.MSGX) S @MAGRY@(MAGCT)=MSGX Q
  1. . ;Added for MAGQI integrity check
  1. . K MAGY
  1. . D CHKGRPCH^MAGGSQI(.MAGY,MAGIEN,MAGDFN,MAGCHILD) I 'MAGY D INVCH(.MAGY,MAGCHILD) S @MAGRY@(MAGCT)=MAGY Q
  1. . S MAGFILE=$$INFO^MAGGAII(MAGCHILD,"E")
  1. . S @MAGRY@(MAGCT)="B2^"_MAGFILE
  1. . ;Test BigGroup I 'BKG S @MAGRY@(MAGCT)="B2^"_MAGFILE
  1. . ;Test BigGroup E S ^TMP("MAGBGRP",MAGIEN,MAGCT)="B2^"_MAGFILE
  1. I FLAGS["D" D ; Patch 117
  1. . ; Get Deleted images
  1. . S MAGCHILD=0
  1. . F S MAGCHILD=$O(^MAG(2005.1,"AGP",MAGIEN,MAGCHILD)) Q:'MAGCHILD D
  1. . . I ($P(^MAG(2005.1,MAGCHILD,100),"^",8)=13) Q ;p150 If ImageNeverExisted Quit.
  1. . . S MAGCT=MAGCT+1
  1. . . S MAGFILE=$$INFO^MAGGAII(MAGCHILD,"D")
  1. . . S @MAGRY@(MAGCT)="B2^"_MAGFILE
  1. . . Q
  1. S @MAGRY@(0)="1^"_MAGCT
  1. Q
  1. INVALID(MAGX,MAGZ) ;
  1. ;
  1. I $$ISDEL^MAGGI11(MAGX) S MAGZ="B2^"_MAGX_"^^^INVALID Reference to Deleted Image^^66^^^^^^^^"
  1. E S MAGZ="B2^"_MAGX_"^^^INVALID Image ID (IEN)^^67^^^^^^^^"
  1. ;Added with MAGQI integrity check,
  1. S MAGTMPAR(MAGX)=""
  1. Q
  1. INVCH(MSG,CHILD) ;Added for MAGQI integrity check
  1. ; MSG is passed by reference, we create a MAGFILE equivalent and pass it back.
  1. N EMSG
  1. S EMSG=$P(MSG,U,2)
  1. K MSG
  1. S $P(MSG,U)=CHILD
  1. ; remove dependency on c:\program files. with .\bmp\
  1. S $P(MSG,U,2,3)="-1~Questionable Data Integrity^.\bmp\imageQA.bmp"
  1. S $P(MSG,U,4)=$P($G(^MAG(2005,CHILD,2)),U,4)
  1. S $P(MSG,U,6)=$S(($P(MSG,U,6)'=11):"99",1:11)
  1. ;this stops Delphi App from changing Abstract BMP to OFFLINE IMAGE
  1. S $P(MSG,U,10)="M"
  1. ;Send the error message
  1. S $P(MSG,U,17)=EMSG
  1. S MSG="B2^"_MSG
  1. S MAGTMPAR(CHILD)=""
  1. Q