Routine: GMTSOBS

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

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

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

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

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)

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

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

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

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

ATTR ; Set Screen Attributes

 N X,IOINHI,IOINORM S X="IOINHI;IOINORM" D ENDR^%ZISS S BOLD=$G(IOINHI),NORM=$G(IOINORM)

KATTR ; Kill Screen Attributes

 K NORM,BOLD Q

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HGMTSOBS   8549     printed  Mar 13, 2025@21:03:13                                                                                                                                                                                                     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

GMTSOBS.m