GMTSMAG ;SLC/RMP - Imaging Health Summary Component ; 08/27/2002
;;2.7;Health Summary;**26,56**;Oct 20, 1995
;
; External References
; DBIA 2791 ^MAG(2005
; DBIA 10022 %XY^%RCR
;
MAIN ; Imaging Component
N %X,%Y,GMI,MAX,MAGDFN,IX,X,PROC,GMTSXX Q:'$D(^MAG(2005,"AC",DFN))
S MAGDFN=DFN,MAX=$S(+($G(GMTSNDM))>0:+($G(GMTSNDM)),1:99999)
D IMGPTRE^GMTSMAGE(.GMTSXX,MAGDFN_"^"_DUZ)
S %X="GMTSXX",%Y="^TMP(""MAG"",$J," D %XY^%RCR Q:'$D(^TMP("MAG",$J))
D WRTMAG S IX=0
F S IX=$O(^TMP("MAG",$J,IX)) Q:IX="" S X=^TMP("MAG",$J,IX) D WRT
K ^TMP("MAG",$J)
Q
WRTMAG ; Writes Imaging Header
D CKP^GMTSUP Q:$D(GMTSQIT) W ?1,"Date/Time",?20,"Procedure",?34,"Short Description",!!
Q
WRT ; Writes Image date/time, procedure, short text
N Y S Y=$P(X,U) S Y=$$FMTE(Y) D CKP^GMTSUP Q:$D(GMTSQIT) D
. W Y,?20,$E($P(X,U,2),1,12),?34,$E($P(X,U,3),1,43),!
Q
FMTE(X) ; Fileman to External
S X=$G(X) D REGDTM4^GMTSU Q X
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HGMTSMAG 987 printed Sep 23, 2025@19:34:07 Page 2
GMTSMAG ;SLC/RMP - Imaging Health Summary Component ; 08/27/2002
+1 ;;2.7;Health Summary;**26,56**;Oct 20, 1995
+2 ;
+3 ; External References
+4 ; DBIA 2791 ^MAG(2005
+5 ; DBIA 10022 %XY^%RCR
+6 ;
MAIN ; Imaging Component
+1 NEW %X,%Y,GMI,MAX,MAGDFN,IX,X,PROC,GMTSXX
if '$DATA(^MAG(2005,"AC",DFN))
QUIT
+2 SET MAGDFN=DFN
SET MAX=$SELECT(+($GET(GMTSNDM))>0:+($GET(GMTSNDM)),1:99999)
+3 DO IMGPTRE^GMTSMAGE(.GMTSXX,MAGDFN_"^"_DUZ)
+4 SET %X="GMTSXX"
SET %Y="^TMP(""MAG"",$J,"
DO %XY^%RCR
if '$DATA(^TMP("MAG",$JOB))
QUIT
+5 DO WRTMAG
SET IX=0
+6 FOR
SET IX=$ORDER(^TMP("MAG",$JOB,IX))
if IX=""
QUIT
SET X=^TMP("MAG",$JOB,IX)
DO WRT
+7 KILL ^TMP("MAG",$JOB)
+8 QUIT
WRTMAG ; Writes Imaging Header
+1 DO CKP^GMTSUP
if $DATA(GMTSQIT)
QUIT
WRITE ?1,"Date/Time",?20,"Procedure",?34,"Short Description",!!
+2 QUIT
WRT ; Writes Image date/time, procedure, short text
+1 NEW Y
SET Y=$PIECE(X,U)
SET Y=$$FMTE(Y)
DO CKP^GMTSUP
if $DATA(GMTSQIT)
QUIT
Begin DoDot:1
+2 WRITE Y,?20,$EXTRACT($PIECE(X,U,2),1,12),?34,$EXTRACT($PIECE(X,U,3),1,43),!
End DoDot:1
+3 QUIT
FMTE(X) ; Fileman to External
+1 SET X=$GET(X)
DO REGDTM4^GMTSU
QUIT X
