GMTSOBS ; SLC/KER - HS Object - Show ; 01/06/2003
;;2.7;Health Summary;**58,89**;Oct 20, 1995;Build 61
;
; External References
; DBIA 10103 $$FMADD^XLFDT
; DBIA 10103 $$NOW^XLFDT
; DBIA 10103 $$FMTE^XLFDT
; DBIA 10104 $$UP^XLFSTR
; DBIA 2056 $$GET1^DIQ (file #200)
; DBIA 10060 ^VA(200, (read w/fileman)
; DBIA 10086 ^%ZIS
; DBIA 10086 HOME^%ZIS
; DBIA 10089 ^%ZISC
; DBIA 10088 ENDR^%ZISS
; DBIA 10063 ^%ZTLOAD
;
Q
DEF(X,GMTSARY) ; Extract Object Definition/Example
N GMTSEXT S GMTSEXT="" D SO($G(X)) Q
SO(X) ; Show Object
N GMTSNAM,GMTSLBL,GMTSTYP,GMTSHST,GMTSPER,GMTSNOD,GMTSPLB,GMTSNODA
N GMTSLBB,GMTSRDT,GMTSCON,GMTSRHD,GMTSCHD,GMTSUND,GMTSLIM,GMTSBLK
N GMTSDEC,GMTSOWN,GMTSCRE,GMTSMOD,GMTSUNT,GMTSLEN,GMTSTIM,GMTSI
N GMTSO,GMTSL,GMTSDTM,GMTSDED,GMTSDCH,GMTSDCN,GMTSTIM,GMTSWIN,TXT S U="^"
S GMTSO=$G(^GMT(142.5,+($G(X)),0))
S GMTSNAM=$P(GMTSO,U,1) Q:'$L(GMTSNAM)
S GMTSLBL=$P(GMTSO,U,2) S:'$L(GMTSLBL) GMTSLBL="UNSPECIFIED"
S (GMTSHST,GMTSTYP)=+($P(GMTSO,U,3)) Q:+GMTSTYP=0
S GMTSTYP=$P($G(^GMT(142,+GMTSTYP,0)),"^",1) Q:'$L(GMTSTYP)
S GMTSPER=$P(GMTSO,U,4)
S GMTSLEN=+GMTSPER
S GMTSUNT=$E(GMTSPER,$L(GMTSPER))
S:+GMTSUNT>0 GMTSUNT="D"
;
S GMTSNOD=+($P(GMTSO,U,5))
S GMTSHDR=+($P(GMTSO,U,6))
S GMTSPLB=+($P(GMTSO,U,7))
S GMTSLBB=+($P(GMTSO,U,8))
S GMTSRDT=+($P(GMTSO,U,9))
S GMTSCON=+($P(GMTSO,U,10))
S GMTSRHD=+($P(GMTSO,U,11))
S GMTSCHD=+($P(GMTSO,U,12))
S GMTSUND=+($P(GMTSO,U,13))
S GMTSLIM=+($P(GMTSO,U,14))
S GMTSBLK=+($P(GMTSO,U,15))
S GMTSDEC=+($P(GMTSO,U,16))
S GMTSOWN=+($P(GMTSO,U,17)),GMTSOWN=$$GET1^DIQ(200,(+GMTSOWN_","),.01)
S GMTSCRE=+($P(GMTSO,U,18)),GMTSCRE=$TR($$FMTE^XLFDT(GMTSCRE,"5ZM"),"@"," ")
S GMTSMOD=+($P(GMTSO,U,19)),GMTSMOD=$TR($$FMTE^XLFDT(GMTSMOD,"5ZM"),"@"," ")
S GMTSNODA=$G(^GMT(142.5,+$G(X),2))
S (GMTSTIM,GMTSPER)=$P(GMTSO,"^",4),GMTSTIM=$S($E(GMTSTIM,$L(GMTSTIM))="Y":" year",$E(GMTSTIM,$L(GMTSTIM))="M":" month",$E(GMTSTIM,$L(GMTSTIM))="W":" week",1:" day")
S:+GMTSPER>1 GMTSTIM=GMTSTIM_"s" S GMTSTIM=+GMTSPER_GMTSTIM
I $L(GMTSPER) D
. N GMTSPX1,GMTSPX2,GMTSLEN,GMTSUNT,GMTSDIF
. S GMTSPX1=$$NOW^XLFDT,GMTSUNT=$E(GMTSPER,$L(GMTSPER)),GMTSLEN=+GMTSPER
. I +GMTSLEN=0!($L(GMTSUNT)'=1)!("DWMY"'[GMTSUNT) S GMTSPER="" Q
. S:GMTSUNT="D" GMTSDIF=GMTSLEN S:GMTSUNT="W" GMTSDIF=GMTSLEN*7
. S:GMTSUNT="M" GMTSDIF=GMTSLEN*30.4 S:GMTSUNT="Y" GMTSDIF=GMTSLEN*365.25
. S GMTSDIF=$P(GMTSDIF,".",1),GMTSPX2=$$FMADD^XLFDT(GMTSPX1,-(GMTSDIF))
. S GMTSPX1=$$UP^XLFSTR($$FMTE^XLFDT(GMTSPX1,"ZD"))
. S GMTSPX2=$$UP^XLFSTR($$FMTE^XLFDT(GMTSPX2,"ZD"))
. S GMTSWIN=GMTSPER_" ("_GMTSPX2_" - "_GMTSPX1_")"
S:'$L(GMTSPER) GMTSPER="UNSPECIFIED"
S:$L($G(GMTSTIM))&('$L($G(GMTSWIN))) GMTSWIN=$G(GMTSTIM)
W:$L($G(GMTSHDR(1))) !,GMTSHDR(1)
W:$L($G(GMTSHDR(2))) !,GMTSHDR(2)
;
S TXT=" OBJECT NAME: "_$G(GMTSNAM)
D D(TXT)
S TXT=" HEALTH SUMMARY TYPE: "_$G(GMTSTYP)
D D(TXT)
;
S TXT=" REPORT PERIOD: "_$G(GMTSPER),TXT=TXT_$J(" ",(41-$L(TXT)))_"PRINT REPORT DATE/TIME: "_$S(+GMTSHDR>0&(+GMTSRDT>0):"YES",+GMTSHDR'>0:"YES",1:"NO")
D D(TXT)
;
S TXT=" LABEL: "_$G(GMTSLBL),TXT=TXT_$J(" ",(41-$L(TXT)))_"PRINT CONFIDENTIALITY BANNER: "_$S(+GMTSHDR>0&(+GMTSCON>0):"YES",+GMTSHDR'>0:"YES",1:"NO")
D D(TXT)
;
S TXT=" PRINT LABEL: "_$S(+GMTSPLB>0:"YES",1:"NO"),TXT=TXT_$J(" ",(41-$L(TXT)))_"PRINT REPORT HEADER: "_$S(+GMTSHDR>0&(+GMTSRHD>0):"YES",+GMTSHDR'>0:"YES",1:"NO")
D D(TXT)
;
S TXT=" BLANK LINE AFTER LABEL: "_$S(+GMTSLBB>0:"YES",1:"NO"),TXT=TXT_$J(" ",(41-$L(TXT)))_"PRINT COMPONENT HEADER: "_$S(+GMTSHDR>0&(+GMTSCHD>0):"YES",+GMTSHDR'>0:"YES",1:"NO")
D D(TXT)
;
S TXT=" SUPPRESS COMPONENTS W/O DATA: "_$S(+GMTSNOD>0:"YES",1:"NO")
S TXT=TXT_$J(" ",(41-$L(TXT)))_" PRINT TIME-OCCURRENCE LIMITS: "_$S(+GMTSHDR>0&(+GMTSLIM>0):"YES",+GMTSHDR'>0:"YES",1:"NO")
D D(TXT)
;
S TXT=" SUPPRESS HEADER: "_$S(+GMTSHDR>0:"YES",1:"NO")
S TXT=TXT_$J(" ",(41-$L(TXT)))_" UNDERLINE COMPONENT HEADER: "_$S(+GMTSHDR>0&(+GMTSUND>0):"YES",1:"NO")
D D(TXT)
;
S TXT=" SUPPRESS DECEASED INFORMATION: "_$S(+GMTSHDR>0&(+GMTSDEC>0):"NO",1:"YES")
S TXT=TXT_$J(" ",(41-$L(TXT)))_" BLANK LINE AFTER HEADER: "_$S(+GMTSHDR>0&(+GMTSBLK>0):"YES",+GMTSHDR'>0:"YES",1:"NO")
D D(TXT)
;
S TXT=" OVERWRITE NO DATA AVAILABLE MESSAGE: "_GMTSNODA
D D(TXT)
S TXT=" CREATOR: "_GMTSOWN
S TXT=TXT_$J(" ",(41-$L(TXT)))_"CREATED: "_GMTSCRE
D D(TXT)
;
S TXT="",TXT=TXT_$J(" ",(41-$L(TXT)))_"LAST MODIFIED: "_GMTSMOD
D D(TXT)
;
Q:$D(GMTSABRR)
;
S TXT=" EXAMPLE:" D E(TXT)
S GMTSDTM=$$NOW^XLFDT,GMTSDED=$$FMADD^XLFDT(GMTSDTM,-2000)
S GMTSDED=$TR($$FMTE^XLFDT($P(GMTSDED,".",1),"2ZM"),"@"," ")
S GMTSDTM=$TR($$FMTE^XLFDT(GMTSDTM,"2ZM"),"@"," ")
S GMTSDCH=$$DCH(+($G(GMTSHST))),GMTSDCN=$P(GMTSDCH,"^",2),GMTSDCH=$P(GMTSDCH,"^",1)
S:'$L(GMTSDCH) GMTSDCH="PN - Progress Notes" S GMTSTIM=$$TIM($G(GMTSPER))
D:+GMTSHDR>0 SP^GMTSOBS2
D:+GMTSHDR'>0 HS^GMTSOBS2
Q
DCH(X) ; Default Component Header
N GMTSABR,GMTSDHD,GMTSDCH,GMTSDCN,GMTSTYP S GMTSTYP=+($G(X)),GMTSABR=$O(^GMT(142,+GMTSTYP,1,0))
S GMTSABR=$G(^GMT(142,+GMTSTYP,1,+GMTSABR,0)),GMTSABR=+($P(GMTSABR,"^",2))
S GMTSDCN=$P($G(^GMT(142.1,+GMTSABR,0)),"^",1),GMTSDHD=$P($G(^GMT(142.1,+GMTSABR,0)),"^",9),GMTSABR=$P($G(^GMT(142.1,+GMTSABR,0)),"^",4)
S GMTSDCH=$S($L(GMTSABR)&($L(GMTSDHD)):(GMTSABR_" - "_GMTSDHD),1:"PN - Progress Notes")
S X=GMTSDCH_"^"_GMTSDCN Q X
TIM(X) ; Time
N GMTSTIM,GMTSPER S (GMTSTIM,GMTSPER)=$G(X) S:'$L(GMTSTIM) (GMTSTIM,GMTSPER)="3M"
S GMTSTIM=$S($E(GMTSTIM,$L(GMTSTIM))="Y":" year",$E(GMTSTIM,$L(GMTSTIM))="M":" month",$E(GMTSTIM,$L(GMTSTIM))="W":" week",1:" day")
S:+GMTSPER>1 GMTSTIM=GMTSTIM_"s" S GMTSTIM=+GMTSPER_GMTSTIM
S X=GMTSTIM Q X
Q
DEV ; Device
I +($G(DFN))=0!('$D(^TMP("GMTSOBJ",$J,DFN))) K ^TMP("GMTSOBJ",$J,DFN) Q
I $D(CAP) D NODEV K ^TMP("GMTSOBJ",$J,DFN) Q
N ZTRTN,%ZIS,IOP,POP S %ZIS="PQ" D ^%ZIS Q:POP I $D(IO("Q")) D QUE Q
NOQUE ; Print without Queuing
N ZTRTN S ZTRTN="DSP^GMTSOBS"
I $D(IOST),$D(IOF) W:IOST["C-"&('$D(GMTSNOI)) @IOF
D @ZTRTN,^%ZISC K ^TMP("GMTSOBJ",$J,DFN) Q
QUE ; Queued Print
N %,ZTDESC,ZTDTH,ZTIO,ZTSAVE,ZTSK,ZTRTN S ZTRTN="DSP^GMTSOBS" K IO("Q"),ZTSAVE
S ZTSAVE("^TMP(""GMTSOBJ"","_$J_","_DFN_",")="" S ZTSAVE("DFN")=""
S:$D(GMTSHDR) ZTSAVE("GMTSHDR")=""
S ZTDESC="Display Health Summary Object" S ZTIO=ION,ZTDTH=$H
D ^%ZTLOAD I '$D(ZTSK) W !!,"Request Cancelled",! H 3 W:$D(IOF) @IOF
I $D(ZTSK) W !!,"Request Queued",! H 3 W:$D(IOF) @IOF
K ZTSK,ZTDESC,ZTDTH,ZTIO,ZTRTN,ZTSAVE D ^%ZISC Q
Q
NODEV ; Print without Device Selection
W !! N ZTRTN,POP,IOP,%ZIS,IOSL S IOSL=99999999999
S ZTRTN="DSP^GMTSOBS" D @ZTRTN,^%ZISC K ^TMP("GMTSOBJ",$J,DFN)
Q
DSP ; Print Health Summary Type
Q:+($G(DFN))=0 N GMTST,GMTSI,GMTSC,GMTSP,GMTSL,GMTSEXIT,GMTSCR,GMTSPL D HOME^%ZIS
S GMTSPL=3,GMTSEXIT=0,GMTSP=$G(IOST),GMTSL=+($G(IOSL)) S:+GMTSL=0 GMTSL=24
D ATTR W !!,$G(BOLD),"<----------------------------- Break in Document ---------------------------->",$G(NORM) S GMTSPL=GMTSPL+1
W !,$G(BOLD),"<---------------------------- Beginning of Object --------------------------->",$G(NORM) S GMTSPL=GMTSPL+1 D KATTR
S GMTSI=0 F S GMTSI=$O(^TMP("GMTSOBJ",$J,DFN,GMTSI)) Q:+GMTSI=0 D
. W !,$G(^TMP("GMTSOBJ",$J,DFN,GMTSI,0)) S GMTSPL=+GMTSPL+1 D CONT
K ^TMP("GMTSOBJ",$J,DFN)
D ATTR W !,$G(BOLD),"<------------------------------ End of Object ------------------------------->",$G(NORM) S GMTSPL=+GMTSPL+1
W !,$G(BOLD),"<----------------------------- Document Resumes ----------------------------->",$G(NORM) D KATTR S GMTSPL=+GMTSPL+1 S:+GMTSL>0 IOSL=GMTSL
S GMTSPL=GMTSL D CONT W:GMTSP["P-"&($D(IOF)) @IOF
Q
D(X) ; Display
I '$D(GMTSEXT) W !,$G(X) Q
N GMTSC S GMTSC=$G(GMTSARY("D",0))+1,GMTSARY("D",+GMTSC)=$G(X),GMTSARY("D",0)=GMTSC
Q
E(X) ; Example
I '$D(GMTSEXT) W !,$G(X) Q
N GMTSC S GMTSC=$G(GMTSARY("E",0))+1,GMTSARY("E",+GMTSC)=$G(X),GMTSARY("E",0)=GMTSC
Q
CONT ; Press <Return> to Continue
I GMTSP["P-" W:$L($G(IOF))&($D(IOF)) @IOF Q
Q:(GMTSP["C-"!(GMTSP=""))&(GMTSPL'>(GMTSL-4)) S GMTSPL=0 Q:GMTSEXIT
N GMTSCR S GMTSPL=0 W !!," Press <Return> to Continue "
R GMTSCR:660 I '$T!(GMTSCR["^") S GMTSCR="^",GMTSEXIT=1
W:GMTSP'["P-"&($D(IOF)) @IOF Q
Q
ATTR ; Set Screen Attributes
N X,IOINHI,IOINORM S X="IOINHI;IOINORM" D ENDR^%ZISS S BOLD=$G(IOINHI),NORM=$G(IOINORM)
Q
KATTR ; Kill Screen Attributes
K NORM,BOLD Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HGMTSOBS 8549 printed Oct 16, 2024@17:59:12 Page 2
GMTSOBS ; SLC/KER - HS Object - Show ; 01/06/2003
+1 ;;2.7;Health Summary;**58,89**;Oct 20, 1995;Build 61
+2 ;
+3 ; External References
+4 ; DBIA 10103 $$FMADD^XLFDT
+5 ; DBIA 10103 $$NOW^XLFDT
+6 ; DBIA 10103 $$FMTE^XLFDT
+7 ; DBIA 10104 $$UP^XLFSTR
+8 ; DBIA 2056 $$GET1^DIQ (file #200)
+9 ; DBIA 10060 ^VA(200, (read w/fileman)
+10 ; DBIA 10086 ^%ZIS
+11 ; DBIA 10086 HOME^%ZIS
+12 ; DBIA 10089 ^%ZISC
+13 ; DBIA 10088 ENDR^%ZISS
+14 ; DBIA 10063 ^%ZTLOAD
+15 ;
+16 QUIT
DEF(X,GMTSARY) ; Extract Object Definition/Example
+1 NEW GMTSEXT
SET GMTSEXT=""
DO SO($GET(X))
QUIT
SO(X) ; Show Object
+1 NEW GMTSNAM,GMTSLBL,GMTSTYP,GMTSHST,GMTSPER,GMTSNOD,GMTSPLB,GMTSNODA
+2 NEW GMTSLBB,GMTSRDT,GMTSCON,GMTSRHD,GMTSCHD,GMTSUND,GMTSLIM,GMTSBLK
+3 NEW GMTSDEC,GMTSOWN,GMTSCRE,GMTSMOD,GMTSUNT,GMTSLEN,GMTSTIM,GMTSI
+4 NEW GMTSO,GMTSL,GMTSDTM,GMTSDED,GMTSDCH,GMTSDCN,GMTSTIM,GMTSWIN,TXT
SET U="^"
+5 SET GMTSO=$GET(^GMT(142.5,+($GET(X)),0))
+6 SET GMTSNAM=$PIECE(GMTSO,U,1)
if '$LENGTH(GMTSNAM)
QUIT
+7 SET GMTSLBL=$PIECE(GMTSO,U,2)
if '$LENGTH(GMTSLBL)
SET GMTSLBL="UNSPECIFIED"
+8 SET (GMTSHST,GMTSTYP)=+($PIECE(GMTSO,U,3))
if +GMTSTYP=0
QUIT
+9 SET GMTSTYP=$PIECE($GET(^GMT(142,+GMTSTYP,0)),"^",1)
if '$LENGTH(GMTSTYP)
QUIT
+10 SET GMTSPER=$PIECE(GMTSO,U,4)
+11 SET GMTSLEN=+GMTSPER
+12 SET GMTSUNT=$EXTRACT(GMTSPER,$LENGTH(GMTSPER))
+13 if +GMTSUNT>0
SET GMTSUNT="D"
+14 ;
+15 SET GMTSNOD=+($PIECE(GMTSO,U,5))
+16 SET GMTSHDR=+($PIECE(GMTSO,U,6))
+17 SET GMTSPLB=+($PIECE(GMTSO,U,7))
+18 SET GMTSLBB=+($PIECE(GMTSO,U,8))
+19 SET GMTSRDT=+($PIECE(GMTSO,U,9))
+20 SET GMTSCON=+($PIECE(GMTSO,U,10))
+21 SET GMTSRHD=+($PIECE(GMTSO,U,11))
+22 SET GMTSCHD=+($PIECE(GMTSO,U,12))
+23 SET GMTSUND=+($PIECE(GMTSO,U,13))
+24 SET GMTSLIM=+($PIECE(GMTSO,U,14))
+25 SET GMTSBLK=+($PIECE(GMTSO,U,15))
+26 SET GMTSDEC=+($PIECE(GMTSO,U,16))
+27 SET GMTSOWN=+($PIECE(GMTSO,U,17))
SET GMTSOWN=$$GET1^DIQ(200,(+GMTSOWN_","),.01)
+28 SET GMTSCRE=+($PIECE(GMTSO,U,18))
SET GMTSCRE=$TRANSLATE($$FMTE^XLFDT(GMTSCRE,"5ZM"),"@"," ")
+29 SET GMTSMOD=+($PIECE(GMTSO,U,19))
SET GMTSMOD=$TRANSLATE($$FMTE^XLFDT(GMTSMOD,"5ZM"),"@"," ")
+30 SET GMTSNODA=$GET(^GMT(142.5,+$GET(X),2))
+31 SET (GMTSTIM,GMTSPER)=$PIECE(GMTSO,"^",4)
SET GMTSTIM=$SELECT($EXTRACT(GMTSTIM,$LENGTH(GMTSTIM))="Y":" year",$EXTRACT(GMTSTIM,$LENGTH(GMTSTIM))="M":" month",$EXTRACT(GMTSTIM,$LENGTH(GMTSTIM))="W":" week",1:" day")
+32 if +GMTSPER>1
SET GMTSTIM=GMTSTIM_"s"
SET GMTSTIM=+GMTSPER_GMTSTIM
+33 IF $LENGTH(GMTSPER)
Begin DoDot:1
+34 NEW GMTSPX1,GMTSPX2,GMTSLEN,GMTSUNT,GMTSDIF
+35 SET GMTSPX1=$$NOW^XLFDT
SET GMTSUNT=$EXTRACT(GMTSPER,$LENGTH(GMTSPER))
SET GMTSLEN=+GMTSPER
+36 IF +GMTSLEN=0!($LENGTH(GMTSUNT)'=1)!("DWMY"'[GMTSUNT)
SET GMTSPER=""
QUIT
+37 if GMTSUNT="D"
SET GMTSDIF=GMTSLEN
if GMTSUNT="W"
SET GMTSDIF=GMTSLEN*7
+38 if GMTSUNT="M"
SET GMTSDIF=GMTSLEN*30.4
if GMTSUNT="Y"
SET GMTSDIF=GMTSLEN*365.25
+39 SET GMTSDIF=$PIECE(GMTSDIF,".",1)
SET GMTSPX2=$$FMADD^XLFDT(GMTSPX1,-(GMTSDIF))
+40 SET GMTSPX1=$$UP^XLFSTR($$FMTE^XLFDT(GMTSPX1,"ZD"))
+41 SET GMTSPX2=$$UP^XLFSTR($$FMTE^XLFDT(GMTSPX2,"ZD"))
+42 SET GMTSWIN=GMTSPER_" ("_GMTSPX2_" - "_GMTSPX1_")"
End DoDot:1
+43 if '$LENGTH(GMTSPER)
SET GMTSPER="UNSPECIFIED"
+44 if $LENGTH($GET(GMTSTIM))&('$LENGTH($GET(GMTSWIN)))
SET GMTSWIN=$GET(GMTSTIM)
+45 if $LENGTH($GET(GMTSHDR(1)))
WRITE !,GMTSHDR(1)
+46 if $LENGTH($GET(GMTSHDR(2)))
WRITE !,GMTSHDR(2)
+47 ;
+48 SET TXT=" OBJECT NAME: "_$GET(GMTSNAM)
+49 DO D(TXT)
+50 SET TXT=" HEALTH SUMMARY TYPE: "_$GET(GMTSTYP)
+51 DO D(TXT)
+52 ;
+53 SET TXT=" REPORT PERIOD: "_$GET(GMTSPER)
SET TXT=TXT_$JUSTIFY(" ",(41-$LENGTH(TXT)))_"PRINT REPORT DATE/TIME: "_$SELECT(+GMTSHDR>0&(+GMTSRDT>0):"YES",+GMTSHDR'>0:"YES",1:"NO")
+54 DO D(TXT)
+55 ;
+56 SET TXT=" LABEL: "_$GET(GMTSLBL)
SET TXT=TXT_$JUSTIFY(" ",(41-$LENGTH(TXT)))_"PRINT CONFIDENTIALITY BANNER: "_$SELECT(+GMTSHDR>0&(+GMTSCON>0):"YES",+GMTSHDR'>0:"YES",1:"NO")
+57 DO D(TXT)
+58 ;
+59 SET TXT=" PRINT LABEL: "_$SELECT(+GMTSPLB>0:"YES",1:"NO")
SET TXT=TXT_$JUSTIFY(" ",(41-$LENGTH(TXT)))_"PRINT REPORT HEADER: "_$SELECT(+GMTSHDR>0&(+GMTSRHD>0):"YES",+GMTSHDR'>0:"YES",1:"NO")
+60 DO D(TXT)
+61 ;
+62 SET TXT=" BLANK LINE AFTER LABEL: "_$SELECT(+GMTSLBB>0:"YES",1:"NO")
SET TXT=TXT_$JUSTIFY(" ",(41-$LENGTH(TXT)))_"PRINT COMPONENT HEADER: "_$SELECT(+GMTSHDR>0&(+GMTSCHD>0):"YES",+GMTSHDR'>0:"YES",1:"NO")
+63 DO D(TXT)
+64 ;
+65 SET TXT=" SUPPRESS COMPONENTS W/O DATA: "_$SELECT(+GMTSNOD>0:"YES",1:"NO")
+66 SET TXT=TXT_$JUSTIFY(" ",(41-$LENGTH(TXT)))_" PRINT TIME-OCCURRENCE LIMITS: "_$SELECT(+GMTSHDR>0&(+GMTSLIM>0):"YES",+GMTSHDR'>0:"YES",1:"NO")
+67 DO D(TXT)
+68 ;
+69 SET TXT=" SUPPRESS HEADER: "_$SELECT(+GMTSHDR>0:"YES",1:"NO")
+70 SET TXT=TXT_$JUSTIFY(" ",(41-$LENGTH(TXT)))_" UNDERLINE COMPONENT HEADER: "_$SELECT(+GMTSHDR>0&(+GMTSUND>0):"YES",1:"NO")
+71 DO D(TXT)
+72 ;
+73 SET TXT=" SUPPRESS DECEASED INFORMATION: "_$SELECT(+GMTSHDR>0&(+GMTSDEC>0):"NO",1:"YES")
+74 SET TXT=TXT_$JUSTIFY(" ",(41-$LENGTH(TXT)))_" BLANK LINE AFTER HEADER: "_$SELECT(+GMTSHDR>0&(+GMTSBLK>0):"YES",+GMTSHDR'>0:"YES",1:"NO")
+75 DO D(TXT)
+76 ;
+77 SET TXT=" OVERWRITE NO DATA AVAILABLE MESSAGE: "_GMTSNODA
+78 DO D(TXT)
+79 SET TXT=" CREATOR: "_GMTSOWN
+80 SET TXT=TXT_$JUSTIFY(" ",(41-$LENGTH(TXT)))_"CREATED: "_GMTSCRE
+81 DO D(TXT)
+82 ;
+83 SET TXT=""
SET TXT=TXT_$JUSTIFY(" ",(41-$LENGTH(TXT)))_"LAST MODIFIED: "_GMTSMOD
+84 DO D(TXT)
+85 ;
+86 if $DATA(GMTSABRR)
QUIT
+87 ;
+88 SET TXT=" EXAMPLE:"
DO E(TXT)
+89 SET GMTSDTM=$$NOW^XLFDT
SET GMTSDED=$$FMADD^XLFDT(GMTSDTM,-2000)
+90 SET GMTSDED=$TRANSLATE($$FMTE^XLFDT($PIECE(GMTSDED,".",1),"2ZM"),"@"," ")
+91 SET GMTSDTM=$TRANSLATE($$FMTE^XLFDT(GMTSDTM,"2ZM"),"@"," ")
+92 SET GMTSDCH=$$DCH(+($GET(GMTSHST)))
SET GMTSDCN=$PIECE(GMTSDCH,"^",2)
SET GMTSDCH=$PIECE(GMTSDCH,"^",1)
+93 if '$LENGTH(GMTSDCH)
SET GMTSDCH="PN - Progress Notes"
SET GMTSTIM=$$TIM($GET(GMTSPER))
+94 if +GMTSHDR>0
DO SP^GMTSOBS2
+95 if +GMTSHDR'>0
DO HS^GMTSOBS2
+96 QUIT
DCH(X) ; Default Component Header
+1 NEW GMTSABR,GMTSDHD,GMTSDCH,GMTSDCN,GMTSTYP
SET GMTSTYP=+($GET(X))
SET GMTSABR=$ORDER(^GMT(142,+GMTSTYP,1,0))
+2 SET GMTSABR=$GET(^GMT(142,+GMTSTYP,1,+GMTSABR,0))
SET GMTSABR=+($PIECE(GMTSABR,"^",2))
+3 SET GMTSDCN=$PIECE($GET(^GMT(142.1,+GMTSABR,0)),"^",1)
SET GMTSDHD=$PIECE($GET(^GMT(142.1,+GMTSABR,0)),"^",9)
SET GMTSABR=$PIECE($GET(^GMT(142.1,+GMTSABR,0)),"^",4)
+4 SET GMTSDCH=$SELECT($LENGTH(GMTSABR)&($LENGTH(GMTSDHD)):(GMTSABR_" - "_GMTSDHD),1:"PN - Progress Notes")
+5 SET X=GMTSDCH_"^"_GMTSDCN
QUIT X
TIM(X) ; Time
+1 NEW GMTSTIM,GMTSPER
SET (GMTSTIM,GMTSPER)=$GET(X)
if '$LENGTH(GMTSTIM)
SET (GMTSTIM,GMTSPER)="3M"
+2 SET GMTSTIM=$SELECT($EXTRACT(GMTSTIM,$LENGTH(GMTSTIM))="Y":" year",$EXTRACT(GMTSTIM,$LENGTH(GMTSTIM))="M":" month",$EXTRACT(GMTSTIM,$LENGTH(GMTSTIM))="W":" week",1:" day")
+3 if +GMTSPER>1
SET GMTSTIM=GMTSTIM_"s"
SET GMTSTIM=+GMTSPER_GMTSTIM
+4 SET X=GMTSTIM
QUIT X
+5 QUIT
DEV ; Device
+1 IF +($GET(DFN))=0!('$DATA(^TMP("GMTSOBJ",$JOB,DFN)))
KILL ^TMP("GMTSOBJ",$JOB,DFN)
QUIT
+2 IF $DATA(CAP)
DO NODEV
KILL ^TMP("GMTSOBJ",$JOB,DFN)
QUIT
+3 NEW ZTRTN,%ZIS,IOP,POP
SET %ZIS="PQ"
DO ^%ZIS
if POP
QUIT
IF $DATA(IO("Q"))
DO QUE
QUIT
NOQUE ; Print without Queuing
+1 NEW ZTRTN
SET ZTRTN="DSP^GMTSOBS"
+2 IF $DATA(IOST)
IF $DATA(IOF)
if IOST["C-"&('$DATA(GMTSNOI))
WRITE @IOF
+3 DO @ZTRTN
DO ^%ZISC
KILL ^TMP("GMTSOBJ",$JOB,DFN)
QUIT
QUE ; Queued Print
+1 NEW %,ZTDESC,ZTDTH,ZTIO,ZTSAVE,ZTSK,ZTRTN
SET ZTRTN="DSP^GMTSOBS"
KILL IO("Q"),ZTSAVE
+2 SET ZTSAVE("^TMP(""GMTSOBJ"","_$JOB_","_DFN_",")=""
SET ZTSAVE("DFN")=""
+3 if $DATA(GMTSHDR)
SET ZTSAVE("GMTSHDR")=""
+4 SET ZTDESC="Display Health Summary Object"
SET ZTIO=ION
SET ZTDTH=$HOROLOG
+5 DO ^%ZTLOAD
IF '$DATA(ZTSK)
WRITE !!,"Request Cancelled",!
HANG 3
if $DATA(IOF)
WRITE @IOF
+6 IF $DATA(ZTSK)
WRITE !!,"Request Queued",!
HANG 3
if $DATA(IOF)
WRITE @IOF
+7 KILL ZTSK,ZTDESC,ZTDTH,ZTIO,ZTRTN,ZTSAVE
DO ^%ZISC
QUIT
+8 QUIT
NODEV ; Print without Device Selection
+1 WRITE !!
NEW ZTRTN,POP,IOP,%ZIS,IOSL
SET IOSL=99999999999
+2 SET ZTRTN="DSP^GMTSOBS"
DO @ZTRTN
DO ^%ZISC
KILL ^TMP("GMTSOBJ",$JOB,DFN)
+3 QUIT
DSP ; Print Health Summary Type
+1 if +($GET(DFN))=0
QUIT
NEW GMTST,GMTSI,GMTSC,GMTSP,GMTSL,GMTSEXIT,GMTSCR,GMTSPL
DO HOME^%ZIS
+2 SET GMTSPL=3
SET GMTSEXIT=0
SET GMTSP=$GET(IOST)
SET GMTSL=+($GET(IOSL))
if +GMTSL=0
SET GMTSL=24
+3 DO ATTR
WRITE !!,$GET(BOLD),"<----------------------------- Break in Document ---------------------------->",$GET(NORM)
SET GMTSPL=GMTSPL+1
+4 WRITE !,$GET(BOLD),"<---------------------------- Beginning of Object --------------------------->",$GET(NORM)
SET GMTSPL=GMTSPL+1
DO KATTR
+5 SET GMTSI=0
FOR
SET GMTSI=$ORDER(^TMP("GMTSOBJ",$JOB,DFN,GMTSI))
if +GMTSI=0
QUIT
Begin DoDot:1
+6 WRITE !,$GET(^TMP("GMTSOBJ",$JOB,DFN,GMTSI,0))
SET GMTSPL=+GMTSPL+1
DO CONT
End DoDot:1
+7 KILL ^TMP("GMTSOBJ",$JOB,DFN)
+8 DO ATTR
WRITE !,$GET(BOLD),"<------------------------------ End of Object ------------------------------->",$GET(NORM)
SET GMTSPL=+GMTSPL+1
+9 WRITE !,$GET(BOLD),"<----------------------------- Document Resumes ----------------------------->",$GET(NORM)
DO KATTR
SET GMTSPL=+GMTSPL+1
if +GMTSL>0
SET IOSL=GMTSL
+10 SET GMTSPL=GMTSL
DO CONT
if GMTSP["P-"&($DATA(IOF))
WRITE @IOF
+11 QUIT
D(X) ; Display
+1 IF '$DATA(GMTSEXT)
WRITE !,$GET(X)
QUIT
+2 NEW GMTSC
SET GMTSC=$GET(GMTSARY("D",0))+1
SET GMTSARY("D",+GMTSC)=$GET(X)
SET GMTSARY("D",0)=GMTSC
+3 QUIT
E(X) ; Example
+1 IF '$DATA(GMTSEXT)
WRITE !,$GET(X)
QUIT
+2 NEW GMTSC
SET GMTSC=$GET(GMTSARY("E",0))+1
SET GMTSARY("E",+GMTSC)=$GET(X)
SET GMTSARY("E",0)=GMTSC
+3 QUIT
CONT ; Press <Return> to Continue
+1 IF GMTSP["P-"
if $LENGTH($GET(IOF))&($DATA(IOF))
WRITE @IOF
QUIT
+2 if (GMTSP["C-"!(GMTSP=""))&(GMTSPL'>(GMTSL-4))
QUIT
SET GMTSPL=0
if GMTSEXIT
QUIT
+3 NEW GMTSCR
SET GMTSPL=0
WRITE !!," Press <Return> to Continue "
+4 READ GMTSCR:660
IF '$TEST!(GMTSCR["^")
SET GMTSCR="^"
SET GMTSEXIT=1
+5 if GMTSP'["P-"&($DATA(IOF))
WRITE @IOF
QUIT
+6 QUIT
ATTR ; Set Screen Attributes
+1 NEW X,IOINHI,IOINORM
SET X="IOINHI;IOINORM"
DO ENDR^%ZISS
SET BOLD=$GET(IOINHI)
SET NORM=$GET(IOINORM)
+2 QUIT
KATTR ; Kill Screen Attributes
+1 KILL NORM,BOLD
QUIT
