MAGGAII ;WOIFO/GEK/SG/JSL/ZEB - RETURNS IMAGE INFO ; 2/20/09 11:37am
;;3.0;IMAGING;**93,94,122,365**;Mar 19, 2002;Build 19;Aug 02, 2012
;; 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
;
;+++++ PERFORMS SPECIAL CONVERSION OF THE DATE/TIME
DTE(DTI) ;
Q $TR($$FMTE^XLFDT(DTI,"5Z"),"@"," ")
;
;+++++ RETURNS THE FULL NAME OF THE IMAGE FILE
;
; MAGXX IEN of the image record in the file #2005
;
; FILETYPE Type of the image: "ABSTRACT", "BIG", or "FULL"
;
; [.MAGTYPE] Reference to a local variable where the location
; code is returned to:
; A Accessible
; M Magnetic
; O Offline
; W WORM
;
; [.MAGJBOL] Reference to a local variable where the Jukebox
; offline message is returned to.
;
; Return Values
; =============
; <0 ErrorCode~ErrorMessage
; "" Name is not available or an error
;
FILENAME(MAGXX,FILETYPE,MAGTYPE,MAGJBOL) ;
N MAGFILE1,MAGJBCP,MAGOFFLN,MAGPREF
S MAGPREF=""
;--- Don't queue a copy from the JukeBox.
S MAGJBCP=0
;--- The FINDFILE^MAGFILEB returns:
; MAGFILE1 File name (e.g. "LA100066.ABS")
; if no Network Location pointer or INVALID Pointer
; then MAGFILE1=-1~NO NETWORK LOCATION POINTER
; or -1~INVALID NETWORK LOCATION POINTER
; MAGFILE1(.01) Image description (e.g. "ONE,PATIENT 111223333")
; MAGJBOL Description of the offline server
; MAGOFFLN Non-zero if the jukebox is offline
; MAGPREF Path (e.g. "C:\TEMP\LA\10\00\")
;--- MAGTYPE "MAG" or "WORM"
D FINDFILE^MAGFILEB
;--- The MAGFILE1 may contain '^' in case of an error
S MAGFILE1=$TR(MAGFILE1,"^","~")
S:$D(MAGFILE1("ERROR")) MAGFILE1=MAGFILE1("ERROR")
S MAGTYPE=$S($G(MAGOFFLN):"O",FILETYPE="FULL":"A",1:$E(MAGTYPE,1))
;--- The following line of code replicates the old functionality
Q:FILETYPE'="BIG" $G(MAGPREF)_MAGFILE1
;--- Return the full name or an empty string in case of an error
Q $S($E(MAGFILE1,1,2)="-1":"",1:$G(MAGPREF)_MAGFILE1)
;
;##### RETURNS THE IMAGE DESCRIPTOR
;
; MAGIEN IEN of the image record in the file #2005 or
; in file #2005.1
;
; FLAGS Flags that control the execution (can be combined):
;
; D Consider only deleted "child" images
; E Consider only existing "child" images
; O Omit special characters from SHORT DESCRIPTION
;
; If neither 'E' nor 'D' flag is provided, then an
; error code is returned.
;
; [[.]GRPCNTS] The $$INFO function need counts of images in the
; group. If these numbers are already available,
; they can be passed as the value of this parameter.
; ^01: Number of existing members of the group
; ^02: Number of deleted members of the group
;
; If this parameter is not defiend or empty, the
; $$INFO function calls the $$GRPCT^MAGGI14 and
; returns the counts in this parameter if it is
; passed by reference.
;
; Input Variables
; ===============
;
; MAGJOB(
; "NETPLC",...)
; "PTNM",...)
; "RPCPORT")
; "RPCSERVER")
;
; MAGNOCHK Skip the questionable integrity checks if this
; variable is defined and not zero.
;
; Output Variables
; ================
;
; MAGJOB(
; "NETPLC",...)
; "PTNM",...)
;
; Return Values
; =============
; <0 Error descriptor (see the $$ERROR^MAGUERR)
; >0 Image descriptor
; ^01: Image IEN
; ^02: Image full path and name
; ^03: Abstract full path and name
; ^04: SHORT DESCRIPTION field and description of
; offline JukeBox
; ^05: PROCEDURE/EXAM DATE/TIME field
; ^06: OBJECT TYPE
; ^07: PROCEDURE field
; ^08: display date
; ^09: PARENT DATA FILE image pointer
; ^10: ABSTYPE: 'M' magnetic, 'W' worm, 'O' offline
; ^11: 'A' accessible, 'O' offline
; ^12: DICOM Series Number
; ^13: DICOM Image Number
; ^14: Count of images in group; 1 if single image
; VISN15
; ^15: Site parameter IEN
; ^16: Site parameter CODE
; ^17: Error description of Integrity Check
; ^18: Image BIGPath and name
; ^19: Patient DFN
; ^20: Patient Name
; ^21: Image Class: Clin,Admin,Clin/Admin,Admin/Clin
; ^22: Date Time Image Saved (7)
; ^23: Document Date (110)
; ^24: Group IEN
; ^25: IEN of the 1s child of the group and child's
; type separated by colon
; ^26: RPC Broker server
; ^27: RPC Broker port
; ^28: Internal value of CONTROLLED IMAGE field (112)
; converted to a number {0|1}
; ^29: Viewable Status
; ^30: Internal value of STATUS field (113)
; ^31: Image annotated flag (0 or 1)
; ^32: Image TIU note is completed (0 or 1)
; ^33: Annotation operation Status
; ^34: Annotation operation Status Description
; ^35: Package is the package: RAD,LAB,MED,SUR,NONE,PHOTOID
;
INFO(MAGIEN,FLAGS,GRPCNTS) ;
N GROUP ; 1 if the entry referenced by MAGIEN is a group
N GRPCH1IEN ; IEN of the first image of the group
N GRPCH1NODE ; Global node of the 1st image od the group
N GRPCH1TYPE ; Type of the first image of the group
N GRPCHCNT ; Number of images in the group
N MAGNODE ; Global node of the image referenced by MAGIEN
N MAGRES ; Result value (image descriptor)
;
;N MAG3P59 ;gek/ out in P94t7
N MAGMSG,MAGN0,MAGN100,MAGN2,MAGN40,MAGJBOL
N MAGVST,MDFN,IEN,PLC,PLCODE,RC,TMP,X,ANNOTATED,TMPN2
;*zeb *365 add support for O flag
N MAGSDESC,BADCHARS,CHR
;
;=== Validate control flags
S FLAGS=$G(FLAGS)
;--- Unknown/Unsupported flag(s)
;*zeb *365 add support for O flag
Q:$TR(FLAGS,"DEO")'="" $$IPVE^MAGUERR("FLAGS")
;--- Missing required flag
Q:$TR(FLAGS,"DE")=FLAGS $$ERROR^MAGUERR(-6,,"D,E")
;
;=== Get the global node of the record
S MAGNODE=$$NODE^MAGGI11(MAGIEN)
;
;=== Initialize variables
S MAGRES=MAGIEN,RC=0
;gek/ out in P94t7 S MAG3P59=$D(MAGJOB("RPCSERVER"))&$D(MAGJOB("RPCPORT"))
D:'$D(MAGJOB("NETPLC")) NETPLCS^MAGGTU6
I MAGNODE'="" D
. S MAGN0=$G(@MAGNODE@(0)),MAGN2=$G(@MAGNODE@(2))
. S MAGN40=$G(@MAGNODE@(40)),MAGN100=$G(@MAGNODE@(100))
E S (MAGN0,MAGN2,MAGN40,MAGN100)=""
;
;=== Cache patient names; call $$GET 1 time not 2000
S MDFN=$P(MAGN0,U,7) ; PATIENT (5)
I MDFN,'$D(MAGJOB("PTNM",MDFN)) D
. S MAGJOB("PTNM",MDFN)=$$GET1^DIQ(2,MDFN_",",.01)
. ;--- Cache no more than 10 records in the MAGJOB("PTNM")
. S TMP=+$P($G(MAGJOB("PTNM")),U,10)
. S MAGJOB("PTNM")=MDFN_U_$P($G(MAGJOB("PTNM")),U,1,9)
. K:TMP>0 MAGJOB("PTNM",TMP)
. Q
;
;=== Process the group header
S GRPCHCNT=0,(GRPCH1IEN,GRPCH1NODE,GRPCH1TYPE)=""
;--- Count the images of the group
S:$G(GRPCNTS)="" GRPCNTS=$$GRPCT^MAGGI14(MAGIEN)
D:GRPCNTS'<0
. S:FLAGS["E" GRPCHCNT=GRPCHCNT+$P(GRPCNTS,U,1) ; Existing entries
. S:FLAGS["D" GRPCHCNT=GRPCHCNT+$P(GRPCNTS,U,2) ; Deleted entries
. Q
;--- Check the object type
S GROUP=$$ISGRP^MAGGI11(MAGIEN)
I GROUP D
. ;--- Get the IEN of the first image of the group
. S GRPCH1IEN=$$GRPCH1^MAGGI14(MAGIEN,FLAGS)
. I GRPCH1IEN'>0 S GRPCH1IEN="" Q
. ;--- If we cannot get the global node of the 1st image of the
. ;--- group (this should never happen) clear its IEN as well.
. S GRPCH1NODE=$$NODE^MAGGI11(GRPCH1IEN,.TMP)
. I GRPCH1NODE="" S GRPCH1IEN="" Q
. ;--- Get the type of the first image of the group
. S GRPCH1TYPE=$P(@GRPCH1NODE@(0),U,6)
. Q
;--- Check the annotation info
S ANNOTATED=+$P($G(^MAG(2005.002,MAGIEN,1,0)),U,4) ;p122 - add IMAGE annotated flag
I 'ANNOTATED I $D(^MAG(2005,MAGIEN,210,0)) S ANNOTATED=1 ;VistARad annotation #2005.001/PS data #2005.05
I 'ANNOTATED I GROUP!$D(^MAG(2005,MAGIEN,1,0)) D ;p122 - find any child w/ annotation
. N NO,CH S NO=0
. F S NO=$O(^MAG(2005,MAGIEN,1,NO)) Q:'NO S CH=+$G(^(NO,0)) S:CH ANNOTATED=+$P($G(^MAG(2005.002,CH,1,0)),U,4) S:$D(^MAG(2005,CH,210,0)) ANNOTATED=1 Q:ANNOTATED
. Q
S:ANNOTATED ANNOTATED=1
;=== If this is a group and it is not empty, then use
; the first image to get the names of image files.
;=== Otherwise, get them from the group header itself.
S IEN=$S(GRPCH1IEN>0:GRPCH1IEN,1:MAGIEN)
;--- Get full path and file name of the Abstract.
S $P(MAGRES,U,3)=$$FILENAME(IEN,"ABSTRACT",.TMP,.MAGJBOL)
S $P(MAGRES,U,10)=TMP ; Abstract type ('M', 'O', or 'W')
;--- Get the full path and file name of the FULL RES image.
S $P(MAGRES,U,2)=$$FILENAME(IEN,"FULL",.TMP)
S $P(MAGRES,U,11)=TMP ; 'A' - accessible, 'O' - offline
;--- Get the full path and file name for the BIG image.
S $P(MAGRES,U,18)=$$FILENAME(IEN,"BIG")
;
;=== Get the site parameters IEN and code
S IEN=0
I 'GROUP D
. ;--- If the record is a standalone image entry, then
. ;--- get the location IEN from this entry.
. S IEN=+$S($P(MAGN0,U,3):$P(MAGN0,U,3),1:$P(MAGN0,U,5))
. Q
E I GRPCH1NODE'="" D
. ;--- If the group references "child" entries of requested kind(s),
. ;--- then get the network location IEN from the 1st one.
. S TMP=$G(@GRPCH1NODE@(0))
. S IEN=+$S($P(TMP,U,3):$P(TMP,U,3),1:$P(TMP,U,5))
. Q
E I (FLAGS'["D")!(FLAGS'["E") D
. ;--- Otherwise, try to get the location IEN from the 1st "child"
. ;--- image regardless of the requested kind (existing or deleted).
. N CH1IEN,CH1NODE
. S CH1IEN=$$GRPCH1^MAGGI14(MAGIEN,"DE") Q:CH1IEN'>0
. S CH1NODE=$$NODE^MAGGI11(CH1IEN) Q:CH1NODE=""
. S TMP=$G(@CH1NODE@(0))
. S IEN=+$S($P(TMP,U,3):$P(TMP,U,3),1:$P(TMP,U,5))
. Q
S PLC=$P($G(MAGJOB("NETPLC",IEN)),U,1) ; Site Parameters IEN
S PLCODE=$P($G(MAGJOB("NETPLC",IEN)),U,2) ; Site Code (e.g. "WAS")
;--- Groups of 0 images need this
S:PLC="" PLC=$G(MAGJOB("PLC")),PLCODE=$G(MAGJOB("PLCODE"))
;
;=== SHORT DESCRIPTION field (10) and description of offline JukeBox
;*zeb *365 add support for O flag
S MAGSDESC=$P(MAGN2,U,4)
I FLAGS["O" D
. S BADCHARS="|"
. F CHR=0:1:31 S BADCHARS=BADCHARS_$C(CHR)
. S MAGSDESC=$TR(MAGSDESC,BADCHARS)
S $P(MAGRES,U,4)=MAGSDESC_$G(MAGJBOL)
;
;=== Various fields
S $P(MAGRES,U,5)=$P(MAGN2,U,5) ; PROCEDURE/EXAM DATE/TIME (15)
S $P(MAGRES,U,6)=$P(MAGN0,U,6) ; OBJECT TYPE (3)
S $P(MAGRES,U,7)=$P(MAGN0,U,8) ; PROCEDURE (6)
S $P(MAGRES,U,8)=$$DTE($P(MAGN2,U,5)) ; Ext. PROCEDURE/EXAM DATE/TIME
S $P(MAGRES,U,9)=$P(MAGN2,U,8) ; PARENT DATA FILE IMAGE POINTER (18)
;
;=== 2/1/99 Dicom Series number and Dicom Image Number
; $p(12) and $p(13)
;
;=== Number of images of requested kind in the group
S $P(MAGRES,U,14)=$S(GRPCHCNT>0:GRPCHCNT,1:1)
;
;=== Site IEN and code
S $P(MAGRES,U,15,16)=PLC_U_PLCODE
;
;=== Data integrity checks
S TMP=$S('$G(MAGNOCHK):"Q",1:"")
S MAGVST=$$VIEWSTAT^MAGGI12(MAGIEN,TMP,.MAGMSG)
;;W !,"MAGVST : ",$G(MAGVST) ; TESTING, TAKE OUT THIS LINE.
I MAGVST["Q" D
. ;--- Remove the file name of the full resolution image
. S $P(MAGRES,U,2)="-1~Questionable Data Integrity"
. ;--- Replace the Abstract with the special bitmap
. S $P(MAGRES,U,3)=".\bmp\imageQA.bmp"
. ;--- Prevent the client from changing the Questionable
. ;--- Integrity abstract bitmap to the Offline bitmap.
. S:$P(MAGRES,U,6)'=11 $P(MAGRES,U,6)=99
. S $P(MAGRES,U,10)="M"
. ;--- Return the error message
. S $P(MAGRES,U,17)=MAGMSG("Q")
. Q
;
;=== Various fields
S $P(MAGRES,U,19)=MDFN ; Patient IEN (DFN)
S $P(MAGRES,U,20)=$S(MDFN:MAGJOB("PTNM",MDFN),1:MDFN)
S $P(MAGRES,U,22)=$$DTE($P(MAGN2,U)) ; DATE/TIME IMAGE SAVED (7)
S $P(MAGRES,U,23)=$$DTE($P(MAGN100,U,6)) ; CREATION DATE (110)
;
;=== Name of the image class
S IEN=+$P(MAGN40,U,3) ; TYPE INDEX (42)
S:IEN>0 $P(MAGRES,U,21)=$$GET1^DIQ(2005.83,IEN_",",1,,,"MAGMSG")
;
;=== If the client is newer than patch 59, then we can set beyond
; 25 pieces. Additional "^" at the end of the result prevents
;=== problems on the client side.
D ;gek/ out in P94t7 I MAG3P59 D
. S $P(MAGRES,U,24)=$P(MAGN0,U,10) ; GROUP PARENT (14)
. S:GRPCHCNT>1 $P(MAGRES,U,25)=GRPCH1IEN_":"_GRPCH1TYPE
. S $P(MAGRES,U,26)=$G(MAGJOB("RPCSERVER")) ; GEK P94 put in $G
. S $P(MAGRES,U,27)=$G(MAGJOB("RPCPORT")) ; GEK P94 put in $G
. S TMP=+$P(MAGN100,U,7) ; CONTROLLED IMAGE (112)
. S $P(MAGRES,U,28)=TMP
. S:TMP $P(MAGRES,U,3)=".\bmp\magsensitive.bmp"
. S TMP=+$P(MAGN100,U,8) ; STATUS (113)
. S $P(MAGRES,U,29)=$$VSTCODE(MAGVST,TMP)
. S $P(MAGRES,U,30)=TMP
. ; patch 122 new data pieces (31-35) for annotation.
. S $P(MAGRES,U,31)=$G(ANNOTATED) ;IMAGE annotated
. S TMP=""
. ; if it is a child of a Group, the Parent data is in the Group.
. S TMPN2=MAGN2 I $P(MAGN0,U,10) S TMPN2=$G(^MAG(2005,$P(MAGN0,U,10),2))
. I $P(TMPN2,U,6)=8925 D DATA^MAGGNTI(.TMP,$P(TMPN2,U,7)) S TMP=$P(TMP,U,6)
. S $P(MAGRES,U,32)=$S(TMP="":"",TMP="COMPLETED":1,1:0) ; if TIU check Note status
. S TMP="" ; use TMP to return Description.
. S $P(MAGRES,U,33)=$$ANNSTAT^MAGGI12(MAGIEN,$P(MAGRES,U,29),.TMP) ;Annotation Status
. S $P(MAGRES,U,34)=TMP ; This is Desc of Annotation Status
. S $P(MAGRES,U,35)=$P(MAGN40,U,1) ;the package RAD,LAB,MED,SUR...etc
. S $P(MAGRES,U,36)="" ; This forces "^" to be last character in string.
. Q:GRPCH1NODE=""
. ;--- If the group header is not marked as controlled but the 1st
. ; image is, override the sensitivity flag so that the image
. ;--- abstract is not shown in the image list.
. I '$P(MAGRES,U,28) D:$P($G(@GRPCH1NODE@(100)),U,7)
. . S $P(MAGRES,U,28)=1,$P(MAGRES,U,3)=".\bmp\magsensitive.bmp"
. . Q
. Q
;gek/ out in P94t7 E S $P(MAGRES,U,25)=""
;
;=== Stop displaying a group of 1 as a group
I GROUP,GRPCHCNT=1 D
. N CH1N100,CH1VST
. S $P(MAGRES,U,1)=GRPCH1IEN ; IEN of the 1st image of the group
. S $P(MAGRES,U,6)=GRPCH1TYPE ; OBJECT TYPE (3) of the 1st image
. ;gek/ out in P94t7 Q:'MAG3P59
. ;--- Get the viewable status of the 1st "child"
. S TMP=$S('$G(MAGNOCHK):"Q",1:"")
. S CH1VST=$$VIEWSTAT^MAGGI12(GRPCH1IEN,TMP)
. ;--- Get the image status of the 1st "child"
. S CH1N100=$S(GRPCH1NODE'="":$G(@GRPCH1NODE@(100)),1:"")
. S TMP=+$P(CH1N100,U,8) ; STATUS (113)
. ;--- Override the group's values with those of Child 1
. S $P(MAGRES,U,29)=$$VSTCODE(CH1VST,TMP) ; numeric code of 'View Status'
. S $P(MAGRES,U,30)=TMP ; Status
. ; ANNOTATED due to only child was annotated
. S $P(MAGRES,U,31)=$G(ANNOTATED,0) ; IMAGE been annotated
. ; Don't change to Child for Report Parent info.
. ; Parent Data values are stored in '2' node of the Group.
. S TMP=""
. I $P(MAGN2,U,6)=8925 D DATA^MAGGNTI(.TMP,$P(MAGN2,U,7)) S TMP=$P(TMP,U,6)
. S $P(MAGRES,U,32)=$S(TMP="COMPLETED":1,1:0)
. ; Now need to change the Annotation Status, cause change in 'View Status'
. S TMP="" ; use TMP to return Description.
. S $P(MAGRES,U,33)=$$ANNSTAT^MAGGI12(GRPCH1IEN,$P(MAGRES,U,29),.TMP) ;Annotation Status
. S $P(MAGRES,U,34)=TMP ; Annotation Status Description.
. ; $P(35) is package RAD,LAB,SUR,MED,NOTE etc defined in Group and Child.
. Q
;
;===
Q MAGRES
;
;+++++ CONVERTS THE VIEWABLE STATUS TO THE NUMERIC CODE
VSTCODE(VST,STATUS) ;
Q $S(VST["D":12,VST["Q":21,VST["T":22,VST["R":23,1:+STATUS)
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HMAGGAII 17105 printed May 25, 2026@12:06:18 Page 2
MAGGAII ;WOIFO/GEK/SG/JSL/ZEB - RETURNS IMAGE INFO ; 2/20/09 11:37am
+1 ;;3.0;IMAGING;**93,94,122,365**;Mar 19, 2002;Build 19;Aug 02, 2012
+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
+18 ;
+19 ;+++++ PERFORMS SPECIAL CONVERSION OF THE DATE/TIME
DTE(DTI) ;
+1 QUIT $TRANSLATE($$FMTE^XLFDT(DTI,"5Z"),"@"," ")
+2 ;
+3 ;+++++ RETURNS THE FULL NAME OF THE IMAGE FILE
+4 ;
+5 ; MAGXX IEN of the image record in the file #2005
+6 ;
+7 ; FILETYPE Type of the image: "ABSTRACT", "BIG", or "FULL"
+8 ;
+9 ; [.MAGTYPE] Reference to a local variable where the location
+10 ; code is returned to:
+11 ; A Accessible
+12 ; M Magnetic
+13 ; O Offline
+14 ; W WORM
+15 ;
+16 ; [.MAGJBOL] Reference to a local variable where the Jukebox
+17 ; offline message is returned to.
+18 ;
+19 ; Return Values
+20 ; =============
+21 ; <0 ErrorCode~ErrorMessage
+22 ; "" Name is not available or an error
+23 ;
FILENAME(MAGXX,FILETYPE,MAGTYPE,MAGJBOL) ;
+1 NEW MAGFILE1,MAGJBCP,MAGOFFLN,MAGPREF
+2 SET MAGPREF=""
+3 ;--- Don't queue a copy from the JukeBox.
+4 SET MAGJBCP=0
+5 ;--- The FINDFILE^MAGFILEB returns:
+6 ; MAGFILE1 File name (e.g. "LA100066.ABS")
+7 ; if no Network Location pointer or INVALID Pointer
+8 ; then MAGFILE1=-1~NO NETWORK LOCATION POINTER
+9 ; or -1~INVALID NETWORK LOCATION POINTER
+10 ; MAGFILE1(.01) Image description (e.g. "ONE,PATIENT 111223333")
+11 ; MAGJBOL Description of the offline server
+12 ; MAGOFFLN Non-zero if the jukebox is offline
+13 ; MAGPREF Path (e.g. "C:\TEMP\LA\10\00\")
+14 ;--- MAGTYPE "MAG" or "WORM"
+15 DO FINDFILE^MAGFILEB
+16 ;--- The MAGFILE1 may contain '^' in case of an error
+17 SET MAGFILE1=$TRANSLATE(MAGFILE1,"^","~")
+18 if $DATA(MAGFILE1("ERROR"))
SET MAGFILE1=MAGFILE1("ERROR")
+19 SET MAGTYPE=$SELECT($GET(MAGOFFLN):"O",FILETYPE="FULL":"A",1:$EXTRACT(MAGTYPE,1))
+20 ;--- The following line of code replicates the old functionality
+21 if FILETYPE'="BIG"
QUIT $GET(MAGPREF)_MAGFILE1
+22 ;--- Return the full name or an empty string in case of an error
+23 QUIT $SELECT($EXTRACT(MAGFILE1,1,2)="-1":"",1:$GET(MAGPREF)_MAGFILE1)
+24 ;
+25 ;##### RETURNS THE IMAGE DESCRIPTOR
+26 ;
+27 ; MAGIEN IEN of the image record in the file #2005 or
+28 ; in file #2005.1
+29 ;
+30 ; FLAGS Flags that control the execution (can be combined):
+31 ;
+32 ; D Consider only deleted "child" images
+33 ; E Consider only existing "child" images
+34 ; O Omit special characters from SHORT DESCRIPTION
+35 ;
+36 ; If neither 'E' nor 'D' flag is provided, then an
+37 ; error code is returned.
+38 ;
+39 ; [[.]GRPCNTS] The $$INFO function need counts of images in the
+40 ; group. If these numbers are already available,
+41 ; they can be passed as the value of this parameter.
+42 ; ^01: Number of existing members of the group
+43 ; ^02: Number of deleted members of the group
+44 ;
+45 ; If this parameter is not defiend or empty, the
+46 ; $$INFO function calls the $$GRPCT^MAGGI14 and
+47 ; returns the counts in this parameter if it is
+48 ; passed by reference.
+49 ;
+50 ; Input Variables
+51 ; ===============
+52 ;
+53 ; MAGJOB(
+54 ; "NETPLC",...)
+55 ; "PTNM",...)
+56 ; "RPCPORT")
+57 ; "RPCSERVER")
+58 ;
+59 ; MAGNOCHK Skip the questionable integrity checks if this
+60 ; variable is defined and not zero.
+61 ;
+62 ; Output Variables
+63 ; ================
+64 ;
+65 ; MAGJOB(
+66 ; "NETPLC",...)
+67 ; "PTNM",...)
+68 ;
+69 ; Return Values
+70 ; =============
+71 ; <0 Error descriptor (see the $$ERROR^MAGUERR)
+72 ; >0 Image descriptor
+73 ; ^01: Image IEN
+74 ; ^02: Image full path and name
+75 ; ^03: Abstract full path and name
+76 ; ^04: SHORT DESCRIPTION field and description of
+77 ; offline JukeBox
+78 ; ^05: PROCEDURE/EXAM DATE/TIME field
+79 ; ^06: OBJECT TYPE
+80 ; ^07: PROCEDURE field
+81 ; ^08: display date
+82 ; ^09: PARENT DATA FILE image pointer
+83 ; ^10: ABSTYPE: 'M' magnetic, 'W' worm, 'O' offline
+84 ; ^11: 'A' accessible, 'O' offline
+85 ; ^12: DICOM Series Number
+86 ; ^13: DICOM Image Number
+87 ; ^14: Count of images in group; 1 if single image
+88 ; VISN15
+89 ; ^15: Site parameter IEN
+90 ; ^16: Site parameter CODE
+91 ; ^17: Error description of Integrity Check
+92 ; ^18: Image BIGPath and name
+93 ; ^19: Patient DFN
+94 ; ^20: Patient Name
+95 ; ^21: Image Class: Clin,Admin,Clin/Admin,Admin/Clin
+96 ; ^22: Date Time Image Saved (7)
+97 ; ^23: Document Date (110)
+98 ; ^24: Group IEN
+99 ; ^25: IEN of the 1s child of the group and child's
+100 ; type separated by colon
+101 ; ^26: RPC Broker server
+102 ; ^27: RPC Broker port
+103 ; ^28: Internal value of CONTROLLED IMAGE field (112)
+104 ; converted to a number {0|1}
+105 ; ^29: Viewable Status
+106 ; ^30: Internal value of STATUS field (113)
+107 ; ^31: Image annotated flag (0 or 1)
+108 ; ^32: Image TIU note is completed (0 or 1)
+109 ; ^33: Annotation operation Status
+110 ; ^34: Annotation operation Status Description
+111 ; ^35: Package is the package: RAD,LAB,MED,SUR,NONE,PHOTOID
+112 ;
INFO(MAGIEN,FLAGS,GRPCNTS) ;
+1 ; 1 if the entry referenced by MAGIEN is a group
NEW GROUP
+2 ; IEN of the first image of the group
NEW GRPCH1IEN
+3 ; Global node of the 1st image od the group
NEW GRPCH1NODE
+4 ; Type of the first image of the group
NEW GRPCH1TYPE
+5 ; Number of images in the group
NEW GRPCHCNT
+6 ; Global node of the image referenced by MAGIEN
NEW MAGNODE
+7 ; Result value (image descriptor)
NEW MAGRES
+8 ;
+9 ;N MAG3P59 ;gek/ out in P94t7
+10 NEW MAGMSG,MAGN0,MAGN100,MAGN2,MAGN40,MAGJBOL
+11 NEW MAGVST,MDFN,IEN,PLC,PLCODE,RC,TMP,X,ANNOTATED,TMPN2
+12 ;*zeb *365 add support for O flag
+13 NEW MAGSDESC,BADCHARS,CHR
+14 ;
+15 ;=== Validate control flags
+16 SET FLAGS=$GET(FLAGS)
+17 ;--- Unknown/Unsupported flag(s)
+18 ;*zeb *365 add support for O flag
+19 if $TRANSLATE(FLAGS,"DEO")'=""
QUIT $$IPVE^MAGUERR("FLAGS")
+20 ;--- Missing required flag
+21 if $TRANSLATE(FLAGS,"DE")=FLAGS
QUIT $$ERROR^MAGUERR(-6,,"D,E")
+22 ;
+23 ;=== Get the global node of the record
+24 SET MAGNODE=$$NODE^MAGGI11(MAGIEN)
+25 ;
+26 ;=== Initialize variables
+27 SET MAGRES=MAGIEN
SET RC=0
+28 ;gek/ out in P94t7 S MAG3P59=$D(MAGJOB("RPCSERVER"))&$D(MAGJOB("RPCPORT"))
+29 if '$DATA(MAGJOB("NETPLC"))
DO NETPLCS^MAGGTU6
+30 IF MAGNODE'=""
Begin DoDot:1
+31 SET MAGN0=$GET(@MAGNODE@(0))
SET MAGN2=$GET(@MAGNODE@(2))
+32 SET MAGN40=$GET(@MAGNODE@(40))
SET MAGN100=$GET(@MAGNODE@(100))
End DoDot:1
+33 IF '$TEST
SET (MAGN0,MAGN2,MAGN40,MAGN100)=""
+34 ;
+35 ;=== Cache patient names; call $$GET 1 time not 2000
+36 ; PATIENT (5)
SET MDFN=$PIECE(MAGN0,U,7)
+37 IF MDFN
IF '$DATA(MAGJOB("PTNM",MDFN))
Begin DoDot:1
+38 SET MAGJOB("PTNM",MDFN)=$$GET1^DIQ(2,MDFN_",",.01)
+39 ;--- Cache no more than 10 records in the MAGJOB("PTNM")
+40 SET TMP=+$PIECE($GET(MAGJOB("PTNM")),U,10)
+41 SET MAGJOB("PTNM")=MDFN_U_$PIECE($GET(MAGJOB("PTNM")),U,1,9)
+42 if TMP>0
KILL MAGJOB("PTNM",TMP)
+43 QUIT
End DoDot:1
+44 ;
+45 ;=== Process the group header
+46 SET GRPCHCNT=0
SET (GRPCH1IEN,GRPCH1NODE,GRPCH1TYPE)=""
+47 ;--- Count the images of the group
+48 if $GET(GRPCNTS)=""
SET GRPCNTS=$$GRPCT^MAGGI14(MAGIEN)
+49 if GRPCNTS'<0
Begin DoDot:1
+50 ; Existing entries
if FLAGS["E"
SET GRPCHCNT=GRPCHCNT+$PIECE(GRPCNTS,U,1)
+51 ; Deleted entries
if FLAGS["D"
SET GRPCHCNT=GRPCHCNT+$PIECE(GRPCNTS,U,2)
+52 QUIT
End DoDot:1
+53 ;--- Check the object type
+54 SET GROUP=$$ISGRP^MAGGI11(MAGIEN)
+55 IF GROUP
Begin DoDot:1
+56 ;--- Get the IEN of the first image of the group
+57 SET GRPCH1IEN=$$GRPCH1^MAGGI14(MAGIEN,FLAGS)
+58 IF GRPCH1IEN'>0
SET GRPCH1IEN=""
QUIT
+59 ;--- If we cannot get the global node of the 1st image of the
+60 ;--- group (this should never happen) clear its IEN as well.
+61 SET GRPCH1NODE=$$NODE^MAGGI11(GRPCH1IEN,.TMP)
+62 IF GRPCH1NODE=""
SET GRPCH1IEN=""
QUIT
+63 ;--- Get the type of the first image of the group
+64 SET GRPCH1TYPE=$PIECE(@GRPCH1NODE@(0),U,6)
+65 QUIT
End DoDot:1
+66 ;--- Check the annotation info
+67 ;p122 - add IMAGE annotated flag
SET ANNOTATED=+$PIECE($GET(^MAG(2005.002,MAGIEN,1,0)),U,4)
+68 ;VistARad annotation #2005.001/PS data #2005.05
IF 'ANNOTATED
IF $DATA(^MAG(2005,MAGIEN,210,0))
SET ANNOTATED=1
+69 ;p122 - find any child w/ annotation
IF 'ANNOTATED
IF GROUP!$DATA(^MAG(2005,MAGIEN,1,0))
Begin DoDot:1
+70 NEW NO,CH
SET NO=0
+71 FOR
SET NO=$ORDER(^MAG(2005,MAGIEN,1,NO))
if 'NO
QUIT
SET CH=+$GET(^(NO,0))
if CH
SET ANNOTATED=+$PIECE($GET(^MAG(2005.002,CH,1,0)),U,4)
if $DATA(^MAG(2005,CH,210,0))
SET ANNOTATED=1
if ANNOTATED
QUIT
+72 QUIT
End DoDot:1
+73 if ANNOTATED
SET ANNOTATED=1
+74 ;=== If this is a group and it is not empty, then use
+75 ; the first image to get the names of image files.
+76 ;=== Otherwise, get them from the group header itself.
+77 SET IEN=$SELECT(GRPCH1IEN>0:GRPCH1IEN,1:MAGIEN)
+78 ;--- Get full path and file name of the Abstract.
+79 SET $PIECE(MAGRES,U,3)=$$FILENAME(IEN,"ABSTRACT",.TMP,.MAGJBOL)
+80 ; Abstract type ('M', 'O', or 'W')
SET $PIECE(MAGRES,U,10)=TMP
+81 ;--- Get the full path and file name of the FULL RES image.
+82 SET $PIECE(MAGRES,U,2)=$$FILENAME(IEN,"FULL",.TMP)
+83 ; 'A' - accessible, 'O' - offline
SET $PIECE(MAGRES,U,11)=TMP
+84 ;--- Get the full path and file name for the BIG image.
+85 SET $PIECE(MAGRES,U,18)=$$FILENAME(IEN,"BIG")
+86 ;
+87 ;=== Get the site parameters IEN and code
+88 SET IEN=0
+89 IF 'GROUP
Begin DoDot:1
+90 ;--- If the record is a standalone image entry, then
+91 ;--- get the location IEN from this entry.
+92 SET IEN=+$SELECT($PIECE(MAGN0,U,3):$PIECE(MAGN0,U,3),1:$PIECE(MAGN0,U,5))
+93 QUIT
End DoDot:1
+94 IF '$TEST
IF GRPCH1NODE'=""
Begin DoDot:1
+95 ;--- If the group references "child" entries of requested kind(s),
+96 ;--- then get the network location IEN from the 1st one.
+97 SET TMP=$GET(@GRPCH1NODE@(0))
+98 SET IEN=+$SELECT($PIECE(TMP,U,3):$PIECE(TMP,U,3),1:$PIECE(TMP,U,5))
+99 QUIT
End DoDot:1
+100 IF '$TEST
IF (FLAGS'["D")!(FLAGS'["E")
Begin DoDot:1
+101 ;--- Otherwise, try to get the location IEN from the 1st "child"
+102 ;--- image regardless of the requested kind (existing or deleted).
+103 NEW CH1IEN,CH1NODE
+104 SET CH1IEN=$$GRPCH1^MAGGI14(MAGIEN,"DE")
if CH1IEN'>0
QUIT
+105 SET CH1NODE=$$NODE^MAGGI11(CH1IEN)
if CH1NODE=""
QUIT
+106 SET TMP=$GET(@CH1NODE@(0))
+107 SET IEN=+$SELECT($PIECE(TMP,U,3):$PIECE(TMP,U,3),1:$PIECE(TMP,U,5))
+108 QUIT
End DoDot:1
+109 ; Site Parameters IEN
SET PLC=$PIECE($GET(MAGJOB("NETPLC",IEN)),U,1)
+110 ; Site Code (e.g. "WAS")
SET PLCODE=$PIECE($GET(MAGJOB("NETPLC",IEN)),U,2)
+111 ;--- Groups of 0 images need this
+112 if PLC=""
SET PLC=$GET(MAGJOB("PLC"))
SET PLCODE=$GET(MAGJOB("PLCODE"))
+113 ;
+114 ;=== SHORT DESCRIPTION field (10) and description of offline JukeBox
+115 ;*zeb *365 add support for O flag
+116 SET MAGSDESC=$PIECE(MAGN2,U,4)
+117 IF FLAGS["O"
Begin DoDot:1
+118 SET BADCHARS="|"
+119 FOR CHR=0:1:31
SET BADCHARS=BADCHARS_$CHAR(CHR)
+120 SET MAGSDESC=$TRANSLATE(MAGSDESC,BADCHARS)
End DoDot:1
+121 SET $PIECE(MAGRES,U,4)=MAGSDESC_$GET(MAGJBOL)
+122 ;
+123 ;=== Various fields
+124 ; PROCEDURE/EXAM DATE/TIME (15)
SET $PIECE(MAGRES,U,5)=$PIECE(MAGN2,U,5)
+125 ; OBJECT TYPE (3)
SET $PIECE(MAGRES,U,6)=$PIECE(MAGN0,U,6)
+126 ; PROCEDURE (6)
SET $PIECE(MAGRES,U,7)=$PIECE(MAGN0,U,8)
+127 ; Ext. PROCEDURE/EXAM DATE/TIME
SET $PIECE(MAGRES,U,8)=$$DTE($PIECE(MAGN2,U,5))
+128 ; PARENT DATA FILE IMAGE POINTER (18)
SET $PIECE(MAGRES,U,9)=$PIECE(MAGN2,U,8)
+129 ;
+130 ;=== 2/1/99 Dicom Series number and Dicom Image Number
+131 ; $p(12) and $p(13)
+132 ;
+133 ;=== Number of images of requested kind in the group
+134 SET $PIECE(MAGRES,U,14)=$SELECT(GRPCHCNT>0:GRPCHCNT,1:1)
+135 ;
+136 ;=== Site IEN and code
+137 SET $PIECE(MAGRES,U,15,16)=PLC_U_PLCODE
+138 ;
+139 ;=== Data integrity checks
+140 SET TMP=$SELECT('$GET(MAGNOCHK):"Q",1:"")
+141 SET MAGVST=$$VIEWSTAT^MAGGI12(MAGIEN,TMP,.MAGMSG)
+142 ;;W !,"MAGVST : ",$G(MAGVST) ; TESTING, TAKE OUT THIS LINE.
+143 IF MAGVST["Q"
Begin DoDot:1
+144 ;--- Remove the file name of the full resolution image
+145 SET $PIECE(MAGRES,U,2)="-1~Questionable Data Integrity"
+146 ;--- Replace the Abstract with the special bitmap
+147 SET $PIECE(MAGRES,U,3)=".\bmp\imageQA.bmp"
+148 ;--- Prevent the client from changing the Questionable
+149 ;--- Integrity abstract bitmap to the Offline bitmap.
+150 if $PIECE(MAGRES,U,6)'=11
SET $PIECE(MAGRES,U,6)=99
+151 SET $PIECE(MAGRES,U,10)="M"
+152 ;--- Return the error message
+153 SET $PIECE(MAGRES,U,17)=MAGMSG("Q")
+154 QUIT
End DoDot:1
+155 ;
+156 ;=== Various fields
+157 ; Patient IEN (DFN)
SET $PIECE(MAGRES,U,19)=MDFN
+158 SET $PIECE(MAGRES,U,20)=$SELECT(MDFN:MAGJOB("PTNM",MDFN),1:MDFN)
+159 ; DATE/TIME IMAGE SAVED (7)
SET $PIECE(MAGRES,U,22)=$$DTE($PIECE(MAGN2,U))
+160 ; CREATION DATE (110)
SET $PIECE(MAGRES,U,23)=$$DTE($PIECE(MAGN100,U,6))
+161 ;
+162 ;=== Name of the image class
+163 ; TYPE INDEX (42)
SET IEN=+$PIECE(MAGN40,U,3)
+164 if IEN>0
SET $PIECE(MAGRES,U,21)=$$GET1^DIQ(2005.83,IEN_",",1,,,"MAGMSG")
+165 ;
+166 ;=== If the client is newer than patch 59, then we can set beyond
+167 ; 25 pieces. Additional "^" at the end of the result prevents
+168 ;=== problems on the client side.
+169 ;gek/ out in P94t7 I MAG3P59 D
Begin DoDot:1
+170 ; GROUP PARENT (14)
SET $PIECE(MAGRES,U,24)=$PIECE(MAGN0,U,10)
+171 if GRPCHCNT>1
SET $PIECE(MAGRES,U,25)=GRPCH1IEN_":"_GRPCH1TYPE
+172 ; GEK P94 put in $G
SET $PIECE(MAGRES,U,26)=$GET(MAGJOB("RPCSERVER"))
+173 ; GEK P94 put in $G
SET $PIECE(MAGRES,U,27)=$GET(MAGJOB("RPCPORT"))
+174 ; CONTROLLED IMAGE (112)
SET TMP=+$PIECE(MAGN100,U,7)
+175 SET $PIECE(MAGRES,U,28)=TMP
+176 if TMP
SET $PIECE(MAGRES,U,3)=".\bmp\magsensitive.bmp"
+177 ; STATUS (113)
SET TMP=+$PIECE(MAGN100,U,8)
+178 SET $PIECE(MAGRES,U,29)=$$VSTCODE(MAGVST,TMP)
+179 SET $PIECE(MAGRES,U,30)=TMP
+180 ; patch 122 new data pieces (31-35) for annotation.
+181 ;IMAGE annotated
SET $PIECE(MAGRES,U,31)=$GET(ANNOTATED)
+182 SET TMP=""
+183 ; if it is a child of a Group, the Parent data is in the Group.
+184 SET TMPN2=MAGN2
IF $PIECE(MAGN0,U,10)
SET TMPN2=$GET(^MAG(2005,$PIECE(MAGN0,U,10),2))
+185 IF $PIECE(TMPN2,U,6)=8925
DO DATA^MAGGNTI(.TMP,$PIECE(TMPN2,U,7))
SET TMP=$PIECE(TMP,U,6)
+186 ; if TIU check Note status
SET $PIECE(MAGRES,U,32)=$SELECT(TMP="":"",TMP="COMPLETED":1,1:0)
+187 ; use TMP to return Description.
SET TMP=""
+188 ;Annotation Status
SET $PIECE(MAGRES,U,33)=$$ANNSTAT^MAGGI12(MAGIEN,$PIECE(MAGRES,U,29),.TMP)
+189 ; This is Desc of Annotation Status
SET $PIECE(MAGRES,U,34)=TMP
+190 ;the package RAD,LAB,MED,SUR...etc
SET $PIECE(MAGRES,U,35)=$PIECE(MAGN40,U,1)
+191 ; This forces "^" to be last character in string.
SET $PIECE(MAGRES,U,36)=""
+192 if GRPCH1NODE=""
QUIT
+193 ;--- If the group header is not marked as controlled but the 1st
+194 ; image is, override the sensitivity flag so that the image
+195 ;--- abstract is not shown in the image list.
+196 IF '$PIECE(MAGRES,U,28)
if $PIECE($GET(@GRPCH1NODE@(100)),U,7)
Begin DoDot:2
+197 SET $PIECE(MAGRES,U,28)=1
SET $PIECE(MAGRES,U,3)=".\bmp\magsensitive.bmp"
+198 QUIT
End DoDot:2
+199 QUIT
End DoDot:1
+200 ;gek/ out in P94t7 E S $P(MAGRES,U,25)=""
+201 ;
+202 ;=== Stop displaying a group of 1 as a group
+203 IF GROUP
IF GRPCHCNT=1
Begin DoDot:1
+204 NEW CH1N100,CH1VST
+205 ; IEN of the 1st image of the group
SET $PIECE(MAGRES,U,1)=GRPCH1IEN
+206 ; OBJECT TYPE (3) of the 1st image
SET $PIECE(MAGRES,U,6)=GRPCH1TYPE
+207 ;gek/ out in P94t7 Q:'MAG3P59
+208 ;--- Get the viewable status of the 1st "child"
+209 SET TMP=$SELECT('$GET(MAGNOCHK):"Q",1:"")
+210 SET CH1VST=$$VIEWSTAT^MAGGI12(GRPCH1IEN,TMP)
+211 ;--- Get the image status of the 1st "child"
+212 SET CH1N100=$SELECT(GRPCH1NODE'="":$GET(@GRPCH1NODE@(100)),1:"")
+213 ; STATUS (113)
SET TMP=+$PIECE(CH1N100,U,8)
+214 ;--- Override the group's values with those of Child 1
+215 ; numeric code of 'View Status'
SET $PIECE(MAGRES,U,29)=$$VSTCODE(CH1VST,TMP)
+216 ; Status
SET $PIECE(MAGRES,U,30)=TMP
+217 ; ANNOTATED due to only child was annotated
+218 ; IMAGE been annotated
SET $PIECE(MAGRES,U,31)=$GET(ANNOTATED,0)
+219 ; Don't change to Child for Report Parent info.
+220 ; Parent Data values are stored in '2' node of the Group.
+221 SET TMP=""
+222 IF $PIECE(MAGN2,U,6)=8925
DO DATA^MAGGNTI(.TMP,$PIECE(MAGN2,U,7))
SET TMP=$PIECE(TMP,U,6)
+223 SET $PIECE(MAGRES,U,32)=$SELECT(TMP="COMPLETED":1,1:0)
+224 ; Now need to change the Annotation Status, cause change in 'View Status'
+225 ; use TMP to return Description.
SET TMP=""
+226 ;Annotation Status
SET $PIECE(MAGRES,U,33)=$$ANNSTAT^MAGGI12(GRPCH1IEN,$PIECE(MAGRES,U,29),.TMP)
+227 ; Annotation Status Description.
SET $PIECE(MAGRES,U,34)=TMP
+228 ; $P(35) is package RAD,LAB,SUR,MED,NOTE etc defined in Group and Child.
+229 QUIT
End DoDot:1
+230 ;
+231 ;===
+232 QUIT MAGRES
+233 ;
+234 ;+++++ CONVERTS THE VIEWABLE STATUS TO THE NUMERIC CODE
VSTCODE(VST,STATUS) ;
+1 QUIT $SELECT(VST["D":12,VST["Q":21,VST["T":22,VST["R":23,1:+STATUS)
