GMTSOBA2.m

GMTSOBA2 ; SLC/KER - HS Object - Ask               ; 01/06/2003

 ;;2.7;Health Summary;**58**;Oct 20, 1995

 ;

 ; External References

 ;   DBIA  10018  ^DIE  (file #142)

 ;   DBIA  10026  ^DIR        

 ;   DBIA  10006  ^DIC  (file #142)

 ;   DBIA  10010  EN1^DIP

 ;   DBIA  10076  ^XUSEC(

 ;   DBIA  10076  ^XUSEC("GMTSMGR")

 ;             

CH ;   Component Header

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

 S GMTSOBJ("COMPONENT HEADER")="",DIR("A")="   Print the standard Component Header?  "

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

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

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

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

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

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

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

 D:$D(GMTSOBJ("COMPONENT HEADER"))&(GMTSE'>0) LM Q:+($G(GMTSQ))>0  Q:+($G(GMTSE))>0

 D:$D(GMTSOBJ("COMPONENT HEADER"))&(GMTSE'>0) UD Q:+($G(GMTSQ))>0  Q:+($G(GMTSE))>0

 D:$D(GMTSOBJ("COMPONENT HEADER"))&(GMTSE'>0) BL Q:+($G(GMTSQ))>0  Q:+($G(GMTSE))>0

 Q

LM ;     Time/Occurence Limits

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

 S GMTSOBJ("LIMITS")="",DIR("A")="     Use report time/occurence limits?  "

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

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

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

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

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

 K:+($G(GMTSE))>0 GMTSOBJ("LIMITS") Q:+($G(GMTSE))>0

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

UD ;     Underline Header

 Q:+($G(GMTSQ))>0  Q:+($G(GMTSE))>0

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

 S GMTSOBJ("UNDERLINE")="",DIR("A")="     Underline Component Header?  "

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

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

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

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

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

 K:+($G(GMTSE))>0 GMTSOBJ("UNDERLINE") Q:+($G(GMTSE))>0

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

BL ;     Blank Line after Header

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

 S GMTSOBJ("BLANK LINE")="",DIR("A")="     Add a Blank Line after the Component Header?  "

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

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

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

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

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

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

DE ;   Deceased

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

 S GMTSOBJ("DECEASED")="",DIR("A")="   Print the date a patient was deceased?  "

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

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

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

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

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

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

LBL ; Label

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

 K GMTSOBJ("USE LABEL"),GMTSOBJ("LABEL"),GMTSOBJ("LABEL BLANK LINE")

 S DIR("A")=" Print a LABEL before the Health Summary Object?  "

 S GMTSDEF=$S(+($G(GMTSDA))>0:$P($G(^GMT(142.5,+($G(GMTSDA)),0)),"^",7),1:0)

 S GMTSDEF=$S(+GMTSDEF>0:"Y",1:"N"),(DIR("?"),DIR("??"))="^D PLB^GMTSOBH",DIR("B")=GMTSDEF,DIR(0)="YAO"

 D ^DIR S:$D(DIROUT)!($D(DTOUT)) GMTSQ=1 S:Y["^"!(X["^") GMTSQ=1

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

 S GMTSOBJ("USE LABEL")=$S(+Y>0:1,1:0)

 S X=+($G(Y)) D:+X LB Q

LB ;   Object Label

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

 S GMTSOBJ("LABEL")="",DIR("A")="   Enter LABEL:  "

 S GMTSDEF=$P($G(^GMT(142.5,+($G(DA)),0)),"^",2) S:$L(GMTSDEF) DIR("B")=GMTSDEF

 S (DIR("?"),DIR("??"))="^D LBH^GMTSOBH",DIR(0)="FAO^3:60"

 D ^DIR S:$D(DIROUT)!($D(DTOUT)) GMTSE=1 S:Y["^"!(X["^") GMTSE=1

 K:+($G(GMTSE))>0 GMTSOBJ("USE LABEL"),GMTSOBJ("LABEL"),GMTSOBJ("LABEL BLANK LINE")

 Q:+($G(GMTSE))>0  S X=$G(Y) K:'$L(X) GMTSOBJ("USE LABEL"),GMTSOBJ("LABEL"),GMTSOBJ("LABEL BLANK LINE")

 S:$L(X) GMTSOBJ("LABEL")=X_" " D:$L($G(GMTSOBJ("LABEL"))) LBB Q

LBB ;   Label Blank Line

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

 S GMTSOBJ("LABEL BLANK LINE")="",DIR("A")="   Print a blank line after the Object Label?  "

 S GMTSDEF=$P($G(^GMT(142.5,+($G(DA)),0)),"^",8)

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

 S (DIR("?"),DIR("??"))="^D LBLH^GMTSOBH",DIR(0)="YAO"

 D ^DIR S:$D(DIROUT)!($D(DTOUT)) GMTSE=1 S:Y["^"!(X["^") GMTSE=1

 K:+($G(GMTSE))>0 GMTSOBJ("LABEL BLANK LINE") Q:+($G(GMTSE))>0

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

SC ; Suppress Components w/o Data

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

 S GMTSOBJ("SUPPRESS COMPONENTS")="",DIR("A")=" Suppress Components without Data?  "

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

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

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

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

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

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

 Q

ET(X) ; Edit Type X

 Q:+($G(DUZ))'>0  N ADEL,B,BY,CHANGE,CNT,DA,DHD,DIC,DIE,DIK,DIR,DIROUT,DLAYGO,DR,DTOUT

 N DUOUT,EXISTS,FLDS,FR,GMTSEG,GMTSIEN,GMTSDEF,GMTSIFN,GMTSMGR,GNTSN

 N GMTSNEW,GMTSQIT,GMTSUM,GMTSV,GMTSAL,D,D0,D1,DQ,Y,L,LCNT,LI

 N NXTCMP,SELCNT,SOACTION,TO,TWEENER S EXISTS=0,U="^",GMTSAL=1,GMTSQIT=0,X=$G(X) Q:'$L(X)  Q:$L(X)>30

 S DIC="^GMT(142,",DIC(0)="XMZ" K DLAYGO D ^DIC

 S GMTSN=$P($G(^GMT(142,+Y,0)),"^",1) Q:'$L(GMTSN)

 S GMTSUM=$P(Y,U,2) Q:'$L(GMTSUM)  S:$D(DIROUT)!($D(DTOUT)) Y=-1 Q:+Y'>0

 S GMTSNEW=+($P(Y,"^",3)),GMTSV=$$VTE^GMTSOBV(+Y) Q:+GMTSV'>0

 S GMTSMGR=$S($D(^XUSEC("GMTSMGR",DUZ)):1,1:0)

 S DIE="^GMT(142,",(GMTSIFN,DA)=+Y

 S DR="[GMTS EDIT EXIST HS TYPE]"

 W !!,"Editing Health Summary Type '",GMTSN,"'",!

 D ^DIE

 S EXISTS=0 S:($O(^GMT(142,+GMTSIFN,1,0))) EXISTS=1

 D LIST:EXISTS,EXISTS

 Q

EXISTS ;   Edit an existing health summary type

 N GMTSAL,CNT,NXTCMP Q:$D(DUOUT)  S NXTCMP=0,NXTCMP(0)=0,GMTSAL=0

 F CNT=$$GETCNT(GMTSIFN):0 D NXTCMP^GMTSRM1,LIST:GMTSQIT Q:GMTSQIT!($D(DUOUT))  K GMTSQIT,GMTSNEW,TWEENER,SOACTION

 I NXTCMP>0 W !,"Please hold on while I resequence the summary order" D COPY^GMTSRN,RNMBR^GMTSRN:CHANGE

 Q

LIST ;   Lists existing summary parameters

 N B,DIC,DIR,IOP,Y,FR,TO,BY,DHD,FLDS,L I GMTSQIT'=2 Q:($D(DUOUT)!(GMTSQIT=1))

 I GMTSQIT=2,(NXTCMP=0) S GMTSQIT=0 Q

 I 'GMTSNEW,'GMTSAL W ! S DIC=142,DIR(0)="Y",DIR("A")="Do you wish to review the Summary Type structure before continuing",DIR("B")="NO" D ^DIR K DIR I 'Y S:GMTSQIT=2 DUOUT="" S:GMTSQIT=2 GMTSQIT="D" S:$D(DUOUT) GMTSQIT=1 Q

 I $D(GMTSQIT),GMTSQIT=2 S GMTSQIT=0

 S IOP="HOME",DIC=142,(FR,TO)=GMTSUM,BY=".01",DHD="[GMTS TYPE INQ HEADER]-[GMTS TYPE INQ FOOTER]",FLDS="[GMTS TYPE INQ]",L=0 D EN1^DIP

 Q

GETCNT(GMTSIFN) ;   Determine default summary order for new component

 N LI,LCNT S LI=0,LCNT=5 F  S LI=$O(^GMT(142,+GMTSIFN,1,LI)) Q:+LI'>0  S LCNT=$P(LI,".")+5

 Q LCNT

GMTSOBA2  ; SLC/KER - HS Object - Ask               ; 01/06/2003

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

 +2       ;

 +3       ; External References

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

 +5       ;   DBIA  10026  ^DIR        

 +6       ;   DBIA  10006  ^DIC  (file #142)

 +7       ;   DBIA  10010  EN1^DIP

 +8       ;   DBIA  10076  ^XUSEC(

 +9       ;   DBIA  10076  ^XUSEC("GMTSMGR")

 +10      ;             

CH        ;   Component Header

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

               QUIT 

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

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

           SET DIR("A")="   Print the standard Component Header?  "

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

           SET GMTSE=0

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

 +5        SET DIR("B")=GMTSDEF

           SET DIR(0)="YAO"

           SET (DIR("?"),DIR("??"))="^D CH^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("COMPONENT HEADER")

           IF +($GET(GMTSQ))>0

               QUIT 

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

           IF +X'>0

               KILL GMTSOBJ("COMPONENT HEADER")

 +10       IF $DATA(GMTSOBJ("COMPONENT HEADER"))&(GMTSE'>0)

               DO LM

           IF +($GET(GMTSQ))>0

               QUIT 

           IF +($GET(GMTSE))>0

               QUIT 

 +11       IF $DATA(GMTSOBJ("COMPONENT HEADER"))&(GMTSE'>0)

               DO UD

           IF +($GET(GMTSQ))>0

               QUIT 

           IF +($GET(GMTSE))>0

               QUIT 

 +12       IF $DATA(GMTSOBJ("COMPONENT HEADER"))&(GMTSE'>0)

               DO BL

           IF +($GET(GMTSQ))>0

               QUIT 

           IF +($GET(GMTSE))>0

               QUIT 

 +13       QUIT 

LM        ;     Time/Occurence Limits

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

               QUIT 

           IF +($GET(GMTSE))>0

               QUIT 

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

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

           SET DIR("A")="     Use report time/occurence limits?  "

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

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

 +5        SET (DIR("?"),DIR("??"))="^D LM^GMTSOBH"

           SET DIR("B")=GMTSDEF

           SET DIR(0)="YAO"

 +6        DO ^DIR

           IF $DATA(DIROUT)!($DATA(DTOUT))

               SET GMTSE=1

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

               SET GMTSE=1

               SET GMTSQ=1

               SET GMTSDES=0

 +8        IF +($GET(GMTSE))>0

               KILL GMTSOBJ("LIMITS")

           IF +($GET(GMTSE))>0

               QUIT 

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

           IF +X'>0

               KILL GMTSOBJ("LIMITS")

           QUIT 

UD        ;     Underline Header

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

               QUIT 

           IF +($GET(GMTSE))>0

               QUIT 

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

 +3        SET GMTSOBJ("UNDERLINE")=""

           SET DIR("A")="     Underline Component Header?  "

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

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

 +6        SET (DIR("?"),DIR("??"))="^D CHU^GMTSOBH"

           SET DIR("B")=GMTSDEF

           SET DIR(0)="YAO"

 +7        DO ^DIR

           IF $DATA(DIROUT)!($DATA(DTOUT))

               SET GMTSE=1

 +8        IF Y["^"!(X["^")

               SET GMTSE=1

               SET GMTSQ=1

               SET GMTSDES=0

 +9        IF +($GET(GMTSE))>0

               KILL GMTSOBJ("UNDERLINE")

           IF +($GET(GMTSE))>0

               QUIT 

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

           IF +X'>0

               KILL GMTSOBJ("UNDERLINE")

           QUIT 

BL        ;     Blank Line after Header

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

               QUIT 

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

 +2        SET GMTSOBJ("BLANK LINE")=""

           SET DIR("A")="     Add a Blank Line after the Component Header?  "

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

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

 +5        SET (DIR("?"),DIR("??"))="^D BL^GMTSOBH"

           SET DIR("B")=GMTSDEF

           SET DIR(0)="YAO"

 +6        DO ^DIR

           IF $DATA(DIROUT)!($DATA(DTOUT))

               SET GMTSQ=1

 +7        IF +($GET(GMTSQ))>0

               KILL GMTSOBJ("BLANK LINE")

           IF +($GET(GMTSQ))>0

               QUIT 

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

           IF +X'>0

               KILL GMTSOBJ("BLANK LINE")

           QUIT 

DE        ;   Deceased

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

               QUIT 

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

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

           SET DIR("A")="   Print the date a patient was deceased?  "

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

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

 +5        SET (DIR("?"),DIR("??"))="^D DE^GMTSOBH"

           SET DIR("B")=GMTSDEF

           SET DIR(0)="YAO"

 +6        DO ^DIR

           IF $DATA(DIROUT)!($DATA(DTOUT))

               SET GMTSQ=1

 +7        IF +($GET(GMTSQ))>0

               KILL GMTSOBJ("DECEASED")

           IF +($GET(GMTSQ))>0

               QUIT 

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

           IF +X'>0

               KILL GMTSOBJ("DECEASED")

           QUIT 

LBL       ; Label

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

               QUIT 

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

 +2        KILL GMTSOBJ("USE LABEL"),GMTSOBJ("LABEL"),GMTSOBJ("LABEL BLANK LINE")

 +3        SET DIR("A")=" Print a LABEL before the Health Summary Object?  "

 +4        SET GMTSDEF=$SELECT(+($GET(GMTSDA))>0:$PIECE($GET(^GMT(142.5,+($GET(GMTSDA)),0)),"^",7),1:0)

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

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

           SET DIR("B")=GMTSDEF

           SET DIR(0)="YAO"

 +6        DO ^DIR

           IF $DATA(DIROUT)!($DATA(DTOUT))

               SET GMTSQ=1

           IF Y["^"!(X["^")

               SET GMTSQ=1

 +7        IF +($GET(GMTSQ))>0

               KILL GMTSOBJ("USE LABEL")

           IF +($GET(GMTSQ))>0

               QUIT 

 +8        SET GMTSOBJ("USE LABEL")=$SELECT(+Y>0:1,1:0)

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

           IF +X

               DO LB

           QUIT 

LB        ;   Object Label

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

               QUIT 

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

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

           SET DIR("A")="   Enter LABEL:  "

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

           IF $LENGTH(GMTSDEF)

               SET DIR("B")=GMTSDEF

 +4        SET (DIR("?"),DIR("??"))="^D LBH^GMTSOBH"

           SET DIR(0)="FAO^3:60"

 +5        DO ^DIR

           IF $DATA(DIROUT)!($DATA(DTOUT))

               SET GMTSE=1

           IF Y["^"!(X["^")

               SET GMTSE=1

 +6        IF +($GET(GMTSE))>0

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

 +7        IF +($GET(GMTSE))>0

               QUIT 

           SET X=$GET(Y)

           IF '$LENGTH(X)

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

 +8        IF $LENGTH(X)

               SET GMTSOBJ("LABEL")=X_" "

           IF $LENGTH($GET(GMTSOBJ("LABEL")))

               DO LBB

           QUIT 

LBB       ;   Label Blank Line

 +1        IF +($GET(GMTSE))>0

               QUIT 

           IF +($GET(GMTSQ))>0

               QUIT 

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

 +2        SET GMTSOBJ("LABEL BLANK LINE")=""

           SET DIR("A")="   Print a blank line after the Object Label?  "

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

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

           SET DIR("B")=GMTSDEF

 +5        SET (DIR("?"),DIR("??"))="^D LBLH^GMTSOBH"

           SET DIR(0)="YAO"

 +6        DO ^DIR

           IF $DATA(DIROUT)!($DATA(DTOUT))

               SET GMTSE=1

           IF Y["^"!(X["^")

               SET GMTSE=1

 +7        IF +($GET(GMTSE))>0

               KILL GMTSOBJ("LABEL BLANK LINE")

           IF +($GET(GMTSE))>0

               QUIT 

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

           IF +X'>0

               KILL GMTSOBJ("LABEL BLANK LINE")

           QUIT 

SC        ; Suppress Components w/o Data

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

               QUIT 

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

 +2        SET GMTSOBJ("SUPPRESS COMPONENTS")=""

           SET DIR("A")=" Suppress Components without Data?  "

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

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

 +5        SET (DIR("?"),DIR("??"))="^D SC^GMTSOBH"

           SET DIR("B")=GMTSDEF

           SET DIR(0)="YAO"

 +6        DO ^DIR

           IF $DATA(DIROUT)!($DATA(DTOUT))

               SET GMTSQ=1

 +7        IF +($GET(GMTSQ))>0

               KILL GMTSOBJ("SUPPRESS COMPONENTS")

           IF +($GET(GMTSQ))>0

               QUIT 

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

           IF +X'>0

               KILL GMTSOBJ("SUPPRESS COMPONENTS")

 +9        QUIT 

ET(X)     ; Edit Type X

 +1        IF +($GET(DUZ))'>0

               QUIT 

           NEW ADEL,B,BY,CHANGE,CNT,DA,DHD,DIC,DIE,DIK,DIR,DIROUT,DLAYGO,DR,DTOUT

 +2        NEW DUOUT,EXISTS,FLDS,FR,GMTSEG,GMTSIEN,GMTSDEF,GMTSIFN,GMTSMGR,GNTSN

 +3        NEW GMTSNEW,GMTSQIT,GMTSUM,GMTSV,GMTSAL,D,D0,D1,DQ,Y,L,LCNT,LI

 +4        NEW NXTCMP,SELCNT,SOACTION,TO,TWEENER

           SET EXISTS=0

           SET U="^"

           SET GMTSAL=1

           SET GMTSQIT=0

           SET X=$GET(X)

           IF '$LENGTH(X)

               QUIT 

           IF $LENGTH(X)>30

               QUIT 

 +5        SET DIC="^GMT(142,"

           SET DIC(0)="XMZ"

           KILL DLAYGO

           DO ^DIC

 +6        SET GMTSN=$PIECE($GET(^GMT(142,+Y,0)),"^",1)

           IF '$LENGTH(GMTSN)

               QUIT 

 +7        SET GMTSUM=$PIECE(Y,U,2)

           IF '$LENGTH(GMTSUM)

               QUIT 

           IF $DATA(DIROUT)!($DATA(DTOUT))

               SET Y=-1

           IF +Y'>0

               QUIT 

 +8        SET GMTSNEW=+($PIECE(Y,"^",3))

           SET GMTSV=$$VTE^GMTSOBV(+Y)

           IF +GMTSV'>0

               QUIT 

 +9        SET GMTSMGR=$SELECT($DATA(^XUSEC("GMTSMGR",DUZ)):1,1:0)

 +10       SET DIE="^GMT(142,"

           SET (GMTSIFN,DA)=+Y

 +11       SET DR="[GMTS EDIT EXIST HS TYPE]"

 +12       WRITE !!,"Editing Health Summary Type '",GMTSN,"'",!

 +13       DO ^DIE

 +14       SET EXISTS=0

           IF ($ORDER(^GMT(142,+GMTSIFN,1,0)))

               SET EXISTS=1

 +15       IF EXISTS

               DO LIST

           DO EXISTS

 +16       QUIT 

EXISTS    ;   Edit an existing health summary type

 +1        NEW GMTSAL,CNT,NXTCMP

           IF $DATA(DUOUT)

               QUIT 

           SET NXTCMP=0

           SET NXTCMP(0)=0

           SET GMTSAL=0

 +2        FOR CNT=$$GETCNT(GMTSIFN):0

               DO NXTCMP^GMTSRM1

               IF GMTSQIT

                   DO LIST

               IF GMTSQIT!($DATA(DUOUT))

                   QUIT 

               KILL GMTSQIT,GMTSNEW,TWEENER,SOACTION

 +3        IF NXTCMP>0

               WRITE !,"Please hold on while I resequence the summary order"

               DO COPY^GMTSRN

               IF CHANGE

                   DO RNMBR^GMTSRN

 +4        QUIT 

LIST      ;   Lists existing summary parameters

 +1        NEW B,DIC,DIR,IOP,Y,FR,TO,BY,DHD,FLDS,L

           IF GMTSQIT'=2

               IF ($DATA(DUOUT)!(GMTSQIT=1))

                   QUIT 

 +2        IF GMTSQIT=2

               IF (NXTCMP=0)

                   SET GMTSQIT=0

                   QUIT 

 +3        IF 'GMTSNEW

               IF 'GMTSAL

                   WRITE !

                   SET DIC=142

                   SET DIR(0)="Y"

                   SET DIR("A")="Do you wish to review the Summary Type structure before continuing"

                   SET DIR("B")="NO"

                   DO ^DIR

                   KILL DIR

                   IF 'Y

                       IF GMTSQIT=2

                           SET DUOUT=""

                       IF GMTSQIT=2

                           SET GMTSQIT="D"

                       IF $DATA(DUOUT)

                           SET GMTSQIT=1

                       QUIT 

 +4        IF $DATA(GMTSQIT)

               IF GMTSQIT=2

                   SET GMTSQIT=0

 +5        SET IOP="HOME"

           SET DIC=142

           SET (FR,TO)=GMTSUM

           SET BY=".01"

           SET DHD="[GMTS TYPE INQ HEADER]-[GMTS TYPE INQ FOOTER]"

           SET FLDS="[GMTS TYPE INQ]"

           SET L=0

           DO EN1^DIP

 +6        QUIT 

GETCNT(GMTSIFN) ;   Determine default summary order for new component

 +1        NEW LI,LCNT

           SET LI=0

           SET LCNT=5

           FOR 

               SET LI=$ORDER(^GMT(142,+GMTSIFN,1,LI))

               IF +LI'>0

                   QUIT 

               SET LCNT=$PIECE(LI,".")+5

 +2        QUIT LCNT