GMTSOBA.m

GMTSOBA ;SLC/KER,PWC - HS Object - Ask ;July 17, 2019@10:12 AM

 ;;2.7;Health Summary;**58,89,130**;Oct 20, 1995;Build 1

 ;

 ; External References

 ;   DBIA  10018  ^DIE  (file #142.5)

 ;   DBIA  10026  ^DIR        

 ;   DBIA  10103  $$FMTE^XLFDT

 ;   DBIA  10103  $$NOW^XLFDT 

 ;             

OBJ ; Create/Edit Object

 N DA,X,Y,DIE,DR,GMTSED,GMTSCON,GMTSLBL,GMTSLBB,GMTSULB,GMTSHDR

 N GMTSRDT,GMTSCON,GMTSRHD,GMTSNEW,GMTSNEWO,GMTSDES,GMTSCHD,GMTSLIM

 N GMTSBLK,GMTSQ,GMTSDEC,GMTSNOD,GMTSOWN,GMTSDT,GMTSI,GMTSDA,GMTSUND

 N GMTSTIM,GMTSTI,GMTSOI,GMTSNDAT

 S (GMTSHDR,GMTSRDT,GMTSCON,GMTSRHD,GMTSCHD,GMTSUND,GMTSLIM,GMTSULB,GMTSLBB,GMTSBLK,GMTSDEC,GMTSNOD)=0,GMTSOWN="",GMTSDES=1

 S:'$L($G(GMTSNAM)) DA=$$LK^GMTSOBL Q:+($G(GMTSQ))>0

 S:$L($G(GMTSNAM)) DA=$$HSO^GMTSOBL($G(GMTSNAM)) Q:+($G(GMTSQ))>0  Q:+($G(DA))'>0

 S:$L($G(GMTSNAM)) GMTSNEW=+($P($G(DA),"^",3)),DA=+($P($G(DA),"^",1))

 Q:+($G(DA))'>0  S (GMTSDA,GMTSOI)=+($G(DA)),GMTSTI=$P($G(^GMT(142.5,+GMTSOI,0)),"^",3) Q:+GMTSTI'>0

 S GMTSLBL="" K GMTSOBJ  S GMTSCON=1

 I $L($G(GMTSNAM)),+GMTSNEW'>0,+DA>0 D  Q:+($G(GMTSCON))'>0  Q:+($G(GMTSQ))>0

 . N GMTSOWN S GMTSOWN=$P($G(^GMT(142.5,+DA,0)),"^",17)

 . I +GMTSOWN>0,+($G(DUZ))>0,+GMTSOWN'=+($G(DUZ)),'$D(^XUSEC("GMTSMGR",DUZ)) S GMTSCON=0 Q

 . W !," Object '",GMTSNAM,"' already exist" S GMTSCON=$$CONT Q:+($G(GMTSCON))'>0

 . N X,Y,DIR,DIE,DR,GMTSDEF,GMTSDICA,GMTSNAM,GMTSTYPE

 . W ! S GMTSDEF=+($P($G(^GMT(142.5,+($G(DA)),0)),"^",3))

 . S GMTSDEF=$S(+GMTSDEF>0:+GMTSDEF,1:"")

 . S GMTSDICA=" Enter/Edit HEALTH SUMMARY TYPE:  "

 . K DTOUT,DUOUT,DIRUT,DIROUT

 . S GMTSTYPE=$$TY^GMTSOBL(GMTSDEF)

 . I $D(DTOUT)!($D(DUOUT))!($D(DIRUT))!($D(DIROUT)) S GMTSQ=1 Q

 . ;VSR - pwc GMTS*2.7*130 change //// to /// for validation before storage

 . S DR=".03///^S X=$G(GMTSTYPE)"

 . S DIE="^GMT(142.5,",DA=+($G(DA)) S GMTSED=0

 . F GMTSI=1:1:3 Q:GMTSI>3  L +^GMT(142.5,+($G(DA))):0 H:'$T 1 I $T D

 . . D ^DIE S GMTSED=1 S $P(^GMT(142.5,+DA,0),U,19)=$$NOW^XLFDT,GMTSI=4

 . . S:+($G(DUZ))>0 $P(^GMT(142.5,+DA,0),"^",17)=+($G(DUZ))

 . I 'GMTSED S GMTSQ=1 K GMTSOBJ W !,"  Record Locked by another user" Q

 . L -^GMT(142.5,+($G(DA))) S GMTST=+($P($G(^GMT(142.5,+DA,0)),U,3))

 K:+($G(GMTSQ))>0 GMTSOBJ Q:+($G(GMTSQ))>0

 D ALL K:+($G(GMTSQ))>0 GMTSOBJ S:+($G(GMTSQ))>0 GMTSDES=0 Q:+($G(GMTSQ))>0  N DIE,DR

 S GMTSHDR=+($G(GMTSOBJ("HEADER")))

 S GMTSLBL=$G(GMTSLBL) I GMTSHDR>0 D

 . S GMTSRDT=$S($D(GMTSOBJ("DATE LINE")):1,1:0)

 . S GMTSCON=$S($D(GMTSOBJ("CONFIDENTIAL")):1,1:0)

 . S GMTSRHD=$S($D(GMTSOBJ("REPORT HEADER")):1,1:0)

 . S GMTSCHD=$S($D(GMTSOBJ("COMPONENT HEADER")):1,1:0)

 . S GMTSUND=$S($D(GMTSOBJ("UNDERLINE")):1,1:0)

 . S GMTSLIM=$S($D(GMTSOBJ("LIMITS")):1,1:0)

 . S GMTSBLK=$S($D(GMTSOBJ("BLANK LINE")):1,1:0)

 . S GMTSDEC=$S($D(GMTSOBJ("DECEASED")):1,1:0)

 . S GMTSULB=$S($D(GMTSOBJ("USE LABEL")):1,1:0)

 . S GMTSLBB=$S($D(GMTSOBJ("LABEL BLANK LINE")):1,1:0)

 . S GMTSNDAT=$G(GMTSOBJ("NO DATA"))

 I GMTSHDR'>0 S (GMTSRDT,GMTSCON,GMTSRHD,GMTSCHD,GMTSUND,GMTSLIM,GMTSBLK,GMTSDEC,GMTSULB,GMTSLBB)=0,GMTSLBL=""

 S GMTSNOD=$S($D(GMTSOBJ("SUPPRESS COMPONENTS")):1,1:0)

 S:+GMTSCHD'>0 (GMTSLIM,GMTSBLK)=0

 S:'$L($G(GMTSLBL)) GMTSLBL="@",(GMTSULB,GMTSLBB)=0

 ; ;VSR  pwc  GMTS*2.7*130  replace //// with /// for validation before storage

 N DR S DR=".02///^S X=$G(GMTSLBL);"

 S:$L($G(GMTSTIM))&($G(GMTSTIM)'="@") DR=DR_".04///^S X=$G(GMTSTIM);"

 S DR=DR_".05///^S X=$G(GMTSNOD);",DR=DR_".06///^S X=$G(GMTSHDR);"

 S DR=DR_".07///^S X=$G(GMTSULB);",DR=DR_".08///^S X=$G(GMTSLBB);"

 S DR=DR_".09///^S X=$G(GMTSRDT);",DR=DR_".1///^S X=$G(GMTSCON);"

 S DR=DR_".11///^S X=$G(GMTSRHD);",DR=DR_".12///^S X=$G(GMTSCHD);"

 S DR=DR_".13///^S X=$G(GMTSUND);",DR=DR_".14///^S X=$G(GMTSLIM);"

 S DR=DR_".15///^S X=$G(GMTSBLK);",DR=DR_".16///^S X=$G(GMTSDEC);"

 S DR=DR_"2///^S X=$G(GMTSNDAT);"

 ; End of VSR patch GMTS*2.7*130

 S:+($G(GMTSDES))>0 DR=DR_"1" S:$E(DR,1)=";" DR=$E(DR,2,$L(DR)) S:$E(DR,$L(DR))=";" DR=$E(DR,1,($L(DR)-1))

 S DIE="^GMT(142.5,",DA=+($G(DA)) S GMTSED=0 W:+($G(GMTSDES))>0 !

 F GMTSI=1:1:3 Q:GMTSI>3  L +^GMT(142.5,+($G(DA))):0 H:'$T 1 I $T D

 . D ^DIE S GMTSED=1 S $P(^GMT(142.5,+DA,0),U,19)=$$NOW^XLFDT,GMTSI=4

 . S:$G(GMTSTIM)="@" $P(^GMT(142.5,+DA,0),U,4)=""

 I 'GMTSED S GMTSQ=1 K GMTSOBJ W !,"  Record Locked by another user" Q

 L -^GMT(142.5,+($G(DA))) S GMTST=+($P($G(^GMT(142.5,+DA,0)),U,3))

 K GMTSOBJ Q

 ;          

ALL ; Print HS Header

 N X,Y,DIR,DIROUT,DUOUT,DTOUT S GMTSOBJ="",GMTSQ=0 D RP Q:+($G(GMTSQ))>0

 S DIR("A")=" Print standard Health Summary Header with the Object?  "

 S DIR("B")="N",DIR(0)="YAO",(DIR("?"),DIR("??"))="^D ALL^GMTSOBH"

 W ! D ^DIR S:$D(DIROUT)!($D(DTOUT)) GMTSQ=1

 S:Y["^"!(X["^") GMTSE=1,GMTSQ=1,GMTSDES=0

 K:+($G(GMTSQ))>0!($D(DUOUT)) GMTSOBJ Q:+($G(GMTSQ))>0!($D(DUOUT))

 S X=+($G(Y)) K:+X>0 GMTSOBJ S:+X'>0 GMTSOBJ=""

 S GMTSOBJ("HEADER")=$S(+X'>0:1,1:0)

 I +X'>0 D

 . W ! D PART Q:+($G(GMTSQ))>1  W ! S GMTSLBL="" D LBL^GMTSOBA2

 . S GMTSLBL=$S($L($G(GMTSOBJ("LABEL"))):$G(GMTSOBJ("LABEL")),1:"@")

 . K:'$L($G(GMTSOBJ("LABEL"))) GMTSLBL,GMTSOBJ("LABEL BLANK LINE"),GMTSOBJ("USE LABEL")

 W ! D SC^GMTSOBA2 K:+($G(GMTSQ))>0 GMTSOBJ

 W ! D NODATA^GMTSOBA2 K:+($G(GMTSQ))>0 GMTSOBJ

 Q

 ;          

RP ; Report Period

 Q:+($G(GMTSQ))>0  N X,Y,DIR,DIROUT,DUOUT,DTOUT,GMTSDEF

 S GMTSTIM=$$RP^GMTSOBT($G(GMTSTI),$G(GMTSOI)) S:+GMTSTIM<0 GMTSQ=1

 Q

 ;                  

PART ; Print Partial Header

 K:+($G(GMTSQ))>0 GMTSOBJ Q:+($G(GMTSQ))>0  W !," Partial Header:"

 D:$D(GMTSOBJ) RD,RC,RH,CH^GMTSOBA2,DE^GMTSOBA2 Q

RD ;   Report Date

 Q:+($G(GMTSQ))>0  N X,Y,DIR,DIROUT,DUOUT,DTOUT,GMTSDEF

 S GMTSDEF=$P($G(^GMT(142.5,+($G(GMTSDA)),0)),U,9)

 S GMTSDEF=$S(+GMTSDEF>0:"Y",1:"N")

 S GMTSOBJ("DATE LINE")="",DIR("A")="   Print Report Date?  "

 S DIR("B")=GMTSDEF,DIR(0)="YAO",(DIR("?"),DIR("??"))="^D RD^GMTSOBH"

 D ^DIR S:$D(DIROUT)!($D(DTOUT)) GMTSQ=1

 S:Y["^"!(X["^") GMTSE=1,GMTSQ=1,GMTSDES=0

 K:+($G(GMTSQ))>0 GMTSOBJ("DATE LINE") Q:+($G(GMTSQ))>0

 S X=+($G(Y)) K:+X'>0 GMTSOBJ("DATE LINE") Q

RC ;   Confidentiality Banner

 Q:+($G(GMTSQ))>0  N X,Y,DIR,DIROUT,DUOUT,DTOUT,GMTSDEF

 S GMTSOBJ("CONFIDENTIAL")="",DIR("A")="   Print Confidentiality Banner?  "

 S GMTSDEF=$P($G(^GMT(142.5,+($G(GMTSDA)),0)),U,10)

 S GMTSDEF=$S(+GMTSDEF>0:"Y",1:"N")

 S DIR("B")=GMTSDEF,DIR(0)="YAO",(DIR("?"),DIR("??"))="^D RC^GMTSOBH"

 D ^DIR S:$D(DIROUT)!($D(DTOUT)) GMTSQ=1

 S:Y["^"!(X["^") GMTSE=1,GMTSQ=1,GMTSDES=0

 K:+($G(GMTSQ))>0 GMTSOBJ("CONFIDENNTIAL") Q:+($G(GMTSQ))>0

 S X=+($G(Y)) K:+X'>0 GMTSOBJ("CONFIDENTIAL") Q

RH ;   Report Header

 Q:+($G(GMTSQ))>0  N X,Y,DIR,DIROUT,DUOUT,DTOUT,GMTSDEF

 S GMTSOBJ("REPORT HEADER")="",DIR("A")="   Print Report Header?  "

 S GMTSDEF=$P($G(^GMT(142.5,+($G(GMTSDA)),0)),U,11)

 S GMTSDEF=$S(+GMTSDEF>0:"Y",1:"N")

 S DIR("B")=GMTSDEF,DIR(0)="YAO",(DIR("?"),DIR("??"))="^D RH^GMTSOBH"

 D ^DIR S:$D(DIROUT)!($D(DTOUT)) GMTSQ=1

 S:Y["^"!(X["^") GMTSE=1,GMTSQ=1,GMTSDES=0

 K:+($G(GMTSQ))>0 GMTSOBJ("REPORT HEADER") Q:+($G(GMTSQ))>0

 S X=+($G(Y)) K:+X'>0 GMTSOBJ("REPORT HEADER") Q

 ;          

CONT(X) ; Continue with Edit

 N DIR,DIROUT,DTOUT

 S DIR(0)="YAO",DIR("B")="NO",DIR("A")=" Do you want to edit the object?  Y/N  "

 D ^DIR S X=+($G(Y)) Q X

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---GMTSOBA   7252     printed  Apr 23, 2025@18:12:44                                                                                                                                                                                                     Page 2

GMTSOBA   ;SLC/KER,PWC - HS Object - Ask ;July 17, 2019@10:12 AM

 +1       ;;2.7;Health Summary;**58,89,130**;Oct 20, 1995;Build 1

 +2       ;

 +3       ; External References

 +4       ;   DBIA  10018  ^DIE  (file #142.5)

 +5       ;   DBIA  10026  ^DIR        

 +6       ;   DBIA  10103  $$FMTE^XLFDT

 +7       ;   DBIA  10103  $$NOW^XLFDT 

 +8       ;             

OBJ       ; Create/Edit Object

 +1        NEW DA,X,Y,DIE,DR,GMTSED,GMTSCON,GMTSLBL,GMTSLBB,GMTSULB,GMTSHDR

 +2        NEW GMTSRDT,GMTSCON,GMTSRHD,GMTSNEW,GMTSNEWO,GMTSDES,GMTSCHD,GMTSLIM

 +3        NEW GMTSBLK,GMTSQ,GMTSDEC,GMTSNOD,GMTSOWN,GMTSDT,GMTSI,GMTSDA,GMTSUND

 +4        NEW GMTSTIM,GMTSTI,GMTSOI,GMTSNDAT

 +5        SET (GMTSHDR,GMTSRDT,GMTSCON,GMTSRHD,GMTSCHD,GMTSUND,GMTSLIM,GMTSULB,GMTSLBB,GMTSBLK,GMTSDEC,GMTSNOD)=0

           SET GMTSOWN=""

           SET GMTSDES=1

 +6        if '$LENGTH($GET(GMTSNAM))

               SET DA=$$LK^GMTSOBL

           if +($GET(GMTSQ))>0

               QUIT 

 +7        if $LENGTH($GET(GMTSNAM))

               SET DA=$$HSO^GMTSOBL($GET(GMTSNAM))

           if +($GET(GMTSQ))>0

               QUIT 

           if +($GET(DA))'>0

               QUIT 

 +8        if $LENGTH($GET(GMTSNAM))

               SET GMTSNEW=+($PIECE($GET(DA),"^",3))

               SET DA=+($PIECE($GET(DA),"^",1))

 +9        if +($GET(DA))'>0

               QUIT 

           SET (GMTSDA,GMTSOI)=+($GET(DA))

           SET GMTSTI=$PIECE($GET(^GMT(142.5,+GMTSOI,0)),"^",3)

           if +GMTSTI'>0

               QUIT 

 +10       SET GMTSLBL=""

           KILL GMTSOBJ

           SET GMTSCON=1

 +11       IF $LENGTH($GET(GMTSNAM))

               IF +GMTSNEW'>0

                   IF +DA>0

                       Begin DoDot:1

 +12                       NEW GMTSOWN

                           SET GMTSOWN=$PIECE($GET(^GMT(142.5,+DA,0)),"^",17)

 +13                       IF +GMTSOWN>0

                               IF +($GET(DUZ))>0

                                   IF +GMTSOWN'=+($GET(DUZ))

                                       IF '$DATA(^XUSEC("GMTSMGR",DUZ))

                                           SET GMTSCON=0

                                           QUIT 

 +14                       WRITE !," Object '",GMTSNAM,"' already exist"

                           SET GMTSCON=$$CONT

                           if +($GET(GMTSCON))'>0

                               QUIT 

 +15                       NEW X,Y,DIR,DIE,DR,GMTSDEF,GMTSDICA,GMTSNAM,GMTSTYPE

 +16                       WRITE !

                           SET GMTSDEF=+($PIECE($GET(^GMT(142.5,+($GET(DA)),0)),"^",3))

 +17                       SET GMTSDEF=$SELECT(+GMTSDEF>0:+GMTSDEF,1:"")

 +18                       SET GMTSDICA=" Enter/Edit HEALTH SUMMARY TYPE:  "

 +19                       KILL DTOUT,DUOUT,DIRUT,DIROUT

 +20                       SET GMTSTYPE=$$TY^GMTSOBL(GMTSDEF)

 +21                       IF $DATA(DTOUT)!($DATA(DUOUT))!($DATA(DIRUT))!($DATA(DIROUT))

                               SET GMTSQ=1

                               QUIT 

 +22      ;VSR - pwc GMTS*2.7*130 change //// to /// for validation before storage

 +23                       SET DR=".03///^S X=$G(GMTSTYPE)"

 +24                       SET DIE="^GMT(142.5,"

                           SET DA=+($GET(DA))

                           SET GMTSED=0

 +25                       FOR GMTSI=1:1:3

                               if GMTSI>3

                                   QUIT 

                               LOCK +^GMT(142.5,+($GET(DA))):0

                               if '$TEST

                                   HANG 1

                               IF $TEST

                                   Begin DoDot:2

 +26                                   DO ^DIE

                                       SET GMTSED=1

                                       SET $PIECE(^GMT(142.5,+DA,0),U,19)=$$NOW^XLFDT

                                       SET GMTSI=4

 +27                                   if +($GET(DUZ))>0

                                           SET $PIECE(^GMT(142.5,+DA,0),"^",17)=+($GET(DUZ))

                                   End DoDot:2

 +28                       IF 'GMTSED

                               SET GMTSQ=1

                               KILL GMTSOBJ

                               WRITE !,"  Record Locked by another user"

                               QUIT 

 +29                       LOCK -^GMT(142.5,+($GET(DA)))

                           SET GMTST=+($PIECE($GET(^GMT(142.5,+DA,0)),U,3))

                       End DoDot:1

                       if +($GET(GMTSCON))'>0

                           QUIT 

                       if +($GET(GMTSQ))>0

                           QUIT 

 +30       if +($GET(GMTSQ))>0

               KILL GMTSOBJ

           if +($GET(GMTSQ))>0

               QUIT 

 +31       DO ALL

           if +($GET(GMTSQ))>0

               KILL GMTSOBJ

           if +($GET(GMTSQ))>0

               SET GMTSDES=0

           if +($GET(GMTSQ))>0

               QUIT 

           NEW DIE,DR

 +32       SET GMTSHDR=+($GET(GMTSOBJ("HEADER")))

 +33       SET GMTSLBL=$GET(GMTSLBL)

           IF GMTSHDR>0

               Begin DoDot:1

 +34               SET GMTSRDT=$SELECT($DATA(GMTSOBJ("DATE LINE")):1,1:0)

 +35               SET GMTSCON=$SELECT($DATA(GMTSOBJ("CONFIDENTIAL")):1,1:0)

 +36               SET GMTSRHD=$SELECT($DATA(GMTSOBJ("REPORT HEADER")):1,1:0)

 +37               SET GMTSCHD=$SELECT($DATA(GMTSOBJ("COMPONENT HEADER")):1,1:0)

 +38               SET GMTSUND=$SELECT($DATA(GMTSOBJ("UNDERLINE")):1,1:0)

 +39               SET GMTSLIM=$SELECT($DATA(GMTSOBJ("LIMITS")):1,1:0)

 +40               SET GMTSBLK=$SELECT($DATA(GMTSOBJ("BLANK LINE")):1,1:0)

 +41               SET GMTSDEC=$SELECT($DATA(GMTSOBJ("DECEASED")):1,1:0)

 +42               SET GMTSULB=$SELECT($DATA(GMTSOBJ("USE LABEL")):1,1:0)

 +43               SET GMTSLBB=$SELECT($DATA(GMTSOBJ("LABEL BLANK LINE")):1,1:0)

 +44               SET GMTSNDAT=$GET(GMTSOBJ("NO DATA"))

               End DoDot:1

 +45       IF GMTSHDR'>0

               SET (GMTSRDT,GMTSCON,GMTSRHD,GMTSCHD,GMTSUND,GMTSLIM,GMTSBLK,GMTSDEC,GMTSULB,GMTSLBB)=0

               SET GMTSLBL=""

 +46       SET GMTSNOD=$SELECT($DATA(GMTSOBJ("SUPPRESS COMPONENTS")):1,1:0)

 +47       if +GMTSCHD'>0

               SET (GMTSLIM,GMTSBLK)=0

 +48       if '$LENGTH($GET(GMTSLBL))

               SET GMTSLBL="@"

               SET (GMTSULB,GMTSLBB)=0

 +49      ; ;VSR  pwc  GMTS*2.7*130  replace //// with /// for validation before storage

 +50       NEW DR

           SET DR=".02///^S X=$G(GMTSLBL);"

 +51       if $LENGTH($GET(GMTSTIM))&($GET(GMTSTIM)'="@")

               SET DR=DR_".04///^S X=$G(GMTSTIM);"

 +52       SET DR=DR_".05///^S X=$G(GMTSNOD);"

           SET DR=DR_".06///^S X=$G(GMTSHDR);"

 +53       SET DR=DR_".07///^S X=$G(GMTSULB);"

           SET DR=DR_".08///^S X=$G(GMTSLBB);"

 +54       SET DR=DR_".09///^S X=$G(GMTSRDT);"

           SET DR=DR_".1///^S X=$G(GMTSCON);"

 +55       SET DR=DR_".11///^S X=$G(GMTSRHD);"

           SET DR=DR_".12///^S X=$G(GMTSCHD);"

 +56       SET DR=DR_".13///^S X=$G(GMTSUND);"

           SET DR=DR_".14///^S X=$G(GMTSLIM);"

 +57       SET DR=DR_".15///^S X=$G(GMTSBLK);"

           SET DR=DR_".16///^S X=$G(GMTSDEC);"

 +58       SET DR=DR_"2///^S X=$G(GMTSNDAT);"

 +59      ; End of VSR patch GMTS*2.7*130

 +60       if +($GET(GMTSDES))>0

               SET DR=DR_"1"

           if $EXTRACT(DR,1)=";"

               SET DR=$EXTRACT(DR,2,$LENGTH(DR))

           if $EXTRACT(DR,$LENGTH(DR))=";"

               SET DR=$EXTRACT(DR,1,($LENGTH(DR)-1))

 +61       SET DIE="^GMT(142.5,"

           SET DA=+($GET(DA))

           SET GMTSED=0

           if +($GET(GMTSDES))>0

               WRITE !

 +62       FOR GMTSI=1:1:3

               if GMTSI>3

                   QUIT 

               LOCK +^GMT(142.5,+($GET(DA))):0

               if '$TEST

                   HANG 1

               IF $TEST

                   Begin DoDot:1

 +63                   DO ^DIE

                       SET GMTSED=1

                       SET $PIECE(^GMT(142.5,+DA,0),U,19)=$$NOW^XLFDT

                       SET GMTSI=4

 +64                   if $GET(GMTSTIM)="@"

                           SET $PIECE(^GMT(142.5,+DA,0),U,4)=""

                   End DoDot:1

 +65       IF 'GMTSED

               SET GMTSQ=1

               KILL GMTSOBJ

               WRITE !,"  Record Locked by another user"

               QUIT 

 +66       LOCK -^GMT(142.5,+($GET(DA)))

           SET GMTST=+($PIECE($GET(^GMT(142.5,+DA,0)),U,3))

 +67       KILL GMTSOBJ

           QUIT 

 +68      ;          

ALL       ; Print HS Header

 +1        NEW X,Y,DIR,DIROUT,DUOUT,DTOUT

           SET GMTSOBJ=""

           SET GMTSQ=0

           DO RP

           if +($GET(GMTSQ))>0

               QUIT 

 +2        SET DIR("A")=" Print standard Health Summary Header with the Object?  "

 +3        SET DIR("B")="N"

           SET DIR(0)="YAO"

           SET (DIR("?"),DIR("??"))="^D ALL^GMTSOBH"

 +4        WRITE !

           DO ^DIR

           if $DATA(DIROUT)!($DATA(DTOUT))

               SET GMTSQ=1

 +5        if Y["^"!(X["^")

               SET GMTSE=1

               SET GMTSQ=1

               SET GMTSDES=0

 +6        if +($GET(GMTSQ))>0!($DATA(DUOUT))

               KILL GMTSOBJ

           if +($GET(GMTSQ))>0!($DATA(DUOUT))

               QUIT 

 +7        SET X=+($GET(Y))

           if +X>0

               KILL GMTSOBJ

           if +X'>0

               SET GMTSOBJ=""

 +8        SET GMTSOBJ("HEADER")=$SELECT(+X'>0:1,1:0)

 +9        IF +X'>0

               Begin DoDot:1

 +10               WRITE !

                   DO PART

                   if +($GET(GMTSQ))>1

                       QUIT 

                   WRITE !

                   SET GMTSLBL=""

                   DO LBL^GMTSOBA2

 +11               SET GMTSLBL=$SELECT($LENGTH($GET(GMTSOBJ("LABEL"))):$GET(GMTSOBJ("LABEL")),1:"@")

 +12               if '$LENGTH($GET(GMTSOBJ("LABEL")))

                       KILL GMTSLBL,GMTSOBJ("LABEL BLANK LINE"),GMTSOBJ("USE LABEL")

               End DoDot:1

 +13       WRITE !

           DO SC^GMTSOBA2

           if +($GET(GMTSQ))>0

               KILL GMTSOBJ

 +14       WRITE !

           DO NODATA^GMTSOBA2

           if +($GET(GMTSQ))>0

               KILL GMTSOBJ

 +15       QUIT 

 +16      ;          

RP        ; Report Period

 +1        if +($GET(GMTSQ))>0

               QUIT 

           NEW X,Y,DIR,DIROUT,DUOUT,DTOUT,GMTSDEF

 +2        SET GMTSTIM=$$RP^GMTSOBT($GET(GMTSTI),$GET(GMTSOI))

           if +GMTSTIM<0

               SET GMTSQ=1

 +3        QUIT 

 +4       ;                  

PART      ; Print Partial Header

 +1        if +($GET(GMTSQ))>0

               KILL GMTSOBJ

           if +($GET(GMTSQ))>0

               QUIT 

           WRITE !," Partial Header:"

 +2        if $DATA(GMTSOBJ)

               DO RD

               DO RC

               DO RH

               DO CH^GMTSOBA2

               DO DE^GMTSOBA2

           QUIT 

RD        ;   Report Date

 +1        if +($GET(GMTSQ))>0

               QUIT 

           NEW X,Y,DIR,DIROUT,DUOUT,DTOUT,GMTSDEF

 +2        SET GMTSDEF=$PIECE($GET(^GMT(142.5,+($GET(GMTSDA)),0)),U,9)

 +3        SET GMTSDEF=$SELECT(+GMTSDEF>0:"Y",1:"N")

 +4        SET GMTSOBJ("DATE LINE")=""

           SET DIR("A")="   Print Report Date?  "

 +5        SET DIR("B")=GMTSDEF

           SET DIR(0)="YAO"

           SET (DIR("?"),DIR("??"))="^D RD^GMTSOBH"

 +6        DO ^DIR

           if $DATA(DIROUT)!($DATA(DTOUT))

               SET GMTSQ=1

 +7        if Y["^"!(X["^")

               SET GMTSE=1

               SET GMTSQ=1

               SET GMTSDES=0

 +8        if +($GET(GMTSQ))>0

               KILL GMTSOBJ("DATE LINE")

           if +($GET(GMTSQ))>0

               QUIT 

 +9        SET X=+($GET(Y))

           if +X'>0

               KILL GMTSOBJ("DATE LINE")

           QUIT 

RC        ;   Confidentiality Banner

 +1        if +($GET(GMTSQ))>0

               QUIT 

           NEW X,Y,DIR,DIROUT,DUOUT,DTOUT,GMTSDEF

 +2        SET GMTSOBJ("CONFIDENTIAL")=""

           SET DIR("A")="   Print Confidentiality Banner?  "

 +3        SET GMTSDEF=$PIECE($GET(^GMT(142.5,+($GET(GMTSDA)),0)),U,10)

 +4        SET GMTSDEF=$SELECT(+GMTSDEF>0:"Y",1:"N")

 +5        SET DIR("B")=GMTSDEF

           SET DIR(0)="YAO"

           SET (DIR("?"),DIR("??"))="^D RC^GMTSOBH"

 +6        DO ^DIR

           if $DATA(DIROUT)!($DATA(DTOUT))

               SET GMTSQ=1

 +7        if Y["^"!(X["^")

               SET GMTSE=1

               SET GMTSQ=1

               SET GMTSDES=0

 +8        if +($GET(GMTSQ))>0

               KILL GMTSOBJ("CONFIDENNTIAL")

           if +($GET(GMTSQ))>0

               QUIT 

 +9        SET X=+($GET(Y))

           if +X'>0

               KILL GMTSOBJ("CONFIDENTIAL")

           QUIT 

RH        ;   Report Header

 +1        if +($GET(GMTSQ))>0

               QUIT 

           NEW X,Y,DIR,DIROUT,DUOUT,DTOUT,GMTSDEF

 +2        SET GMTSOBJ("REPORT HEADER")=""

           SET DIR("A")="   Print Report Header?  "

 +3        SET GMTSDEF=$PIECE($GET(^GMT(142.5,+($GET(GMTSDA)),0)),U,11)

 +4        SET GMTSDEF=$SELECT(+GMTSDEF>0:"Y",1:"N")

 +5        SET DIR("B")=GMTSDEF

           SET DIR(0)="YAO"

           SET (DIR("?"),DIR("??"))="^D RH^GMTSOBH"

 +6        DO ^DIR

           if $DATA(DIROUT)!($DATA(DTOUT))

               SET GMTSQ=1

 +7        if Y["^"!(X["^")

               SET GMTSE=1

               SET GMTSQ=1

               SET GMTSDES=0

 +8        if +($GET(GMTSQ))>0

               KILL GMTSOBJ("REPORT HEADER")

           if +($GET(GMTSQ))>0

               QUIT 

 +9        SET X=+($GET(Y))

           if +X'>0

               KILL GMTSOBJ("REPORT HEADER")

           QUIT 

 +10      ;          

CONT(X)   ; Continue with Edit

 +1        NEW DIR,DIROUT,DTOUT

 +2        SET DIR(0)="YAO"

           SET DIR("B")="NO"

           SET DIR("A")=" Do you want to edit the object?  Y/N  "

 +3        DO ^DIR

           SET X=+($GET(Y))

           QUIT X