GMTSXAP2.m

GMTSXAP2 ; SLC/KER - List Parameters/Precedence 2         ; 02/27/2002

 ;;2.7;Health Summary;**47,49**;Oct 20, 1995

 Q

 ;                          

 ; External References in GMTSXAP2

 ;    DBIA  2056  $$GET1^DIQ

 ;    DBIA  2343  $$ACTIVE^XUSER

 ;    DBIA 10006  ^DIC

 ;    DBIA 10026  ^DIR

 ;    DBIA 10018  ^DIE

 ;    DBIA 10013  ^DIK

 ;                        

 ; Check to see if Compiled Order is correct

OK(X) ;   Ask if Ok

 N Y,DIR,GMTSTOT,GMTSOLD S GMTSNEW=$G(GMTSNEW),GMTSOLD=$$OLD

 S GMTSTOT=$$ORT S:GMTSTOT=1 X=$$OKO S:GMTSTOT>1 X=$$OKM S:GMTSTOT'>0 X=0

 Q X

OKM(X) ;     Multiple entities selected     i.e. USR;SYS

 N DIR,Y,DIROUT,DUOUT,DTOUT S X=1 D OKA Q:'$D(DIR) 0

 D YND

 Q X

OKO(X) ;     Only one entity selected       i.e. USR

 I '$L($G(GMTSORD(1)))!($L($P(GMTSORD(1),"^",1))'=3)!($L($P(GMTSORD(1),"^",3))'>0) Q 0

 N DIR,Y,DIROUT,DUOUT,DTOUT D OKA Q:'$D(DIR) 0

 D YND

 Q X

OKA ;   Set up Prompts - DIR("A")

 N GMTSC,GMTSI,GMTST S (GMTSC,GMTSI)=0 S GMTST=$$ORT

MUL ;     Multiple Entities

 I GMTST>1 D  Q

 . K DIR N GMTSTC,GMTSA,GMTSC S GMTSC=0,GMTSA=GMTST+4 S GMTSTC=$S(GMTST=2:"two",GMTST=3:"three",1:"several")

 . S DIR("A",1)="",DIR("A",2)=" You have selected "_GMTSTC_" Health Summary Types, arranged "

 . S DIR("A",3)=" in the following order:",DIR("A",4)=""

 . F GMTSA=1:1:GMTST S DIR("A",(4+GMTSA))="  "_$J(GMTSA,2)_"    "_$P($G(GMTSORD(+GMTSA)),"^",3)

 . S GMTSA=+($O(DIR("A"," "),-1))+1,DIR("A",GMTSA)="",DIR("A")=" Is this precedence correct?  (Y/N)  ",DIR(0)="YAO",DIR("B")="Y"

ONE ;     One Entity

 I GMTST=1 D  Q

 . I $L($G(GMTSORD(1))),$L($P(GMTSORD(1),"^",1))=3,$L($P(GMTSORD(1),"^",3))>0 D  Q

 . . K DIR S DIR("A",1)=""

 . . S DIR("A",2)=" You have selected one Health Summary Type"

 . . S DIR("A",3)=""

 . . S DIR("A",4)="    "_$P($G(GMTSORD(1)),"^",3)

 . . S DIR("A",5)=""

 . . S DIR("A")=" Is this correct?  (Y/N)  "

 . . S DIR(0)="YAO",DIR("B")="Y"

 . K DIR

 K DIR

 Q

 ;            

YND ; Yes/No/Delete

 W ! S X=$G(X) S:$L($G(DIR("A"))) DIR("A")=" Is this correct?  (Y/N)  "

 S (DIR("?"),DIR("??"))="^D YNDH^GMTSXAP2"

 S DIR(0)="FAO^1;3^K:$$YNDI^GMTSXAP2(X)'>0 X",DIR("B")="Y"

 D ^DIR S X=$$YNDO(X) S:X["^" GMTSEXIT=1 S:X="@" GMTSEXIT=1,GMTSCPL("@")=""

 S:X="N"&($L(GMTSNEW))&(GMTSNEW=GMTSOLD) GMTSEXIT=1,GMTSCPL("@")=""

 S X=$S(X="Y":1,X="N":0,1:-1)

 Q

YNDI(X) ;   Input Transform

 N GMTS S GMTS=$$UP^GMTSXA($G(X)) Q:$L(GMTS)&("^Y^YE^YES^N^NO^@^^^^^"'[("^"_GMTS_"^")) 0 Q 1

YNDO(X) ;   Output Transform

 N GMTS S GMTS=$$UP^GMTSXA($G(X)) S X=$S($E(GMTS,1)="Y":"Y",$E(GMTS,1)="N":"N",$E(GMTS,1)="@":"@",GMTS["^^":"^^",1:"^")

 S X=$S($D(DUOUT):"^",1:X),X=$S($D(DTOUT):"^^",$D(DIROUT):"^^",1:X) Q X

YNDH ;   Help

 W !,"    Enter either 'Y'es, 'N'o, or '^' to exit" Q

 Q

 ;            

EDIT(GMTSUXR,X) ; Edit "Append/Overwrite"

 N DIC,DIE,DTOUT,DUOUT,Y,DR,DA,GMTSACT,GMTSDAT,GMTSPREF,GMTSA

 S GMTSDAT=$G(X),GMTSUSR=+($G(GMTSUSR)) Q:GMTSUSR=0  S GMTSACT=$$ACTIVE^XUSER(+GMTSUSR) D:+GMTSACT'>0 DP(GMTSUSR) Q:+GMTSACT'>0

 S GMTSPREF=$$PENT(GMTSUSR) Q:+GMTSPREF'>0

 S DIE="^GMT(142.98,",DA=+($G(GMTSUSR)),DR="11///^S X=GMTSDAT"

ED ;   Lock Record, Edit Entry

 L +^GMT(142.98,+GMTSPREF):0 I $T D ^DIE L -^GMT(142.98,+GMTSPREF) Q

 S GMTSA=+($G(GMTSA))+1 Q:GMTSA>3  H 1 G ED

 Q

 ;            

 ; Deletions

ADEL ;   Ask for Deletion of Precedence

 N X,Y,GMTSU,GMTSACT,GMTSDEF S GMTSU=$G(GMTSUSR),GMTSACT=$$ACTIVE^XUSER(+GMTSU) D:+GMTSACT'>0 DP(GMTSUSR) Q:+GMTSACT'>0  S X=$$UNM^GMTSXAW3(+($G(GMTSUSR))) Q:'$L(X)

 Q:'$D(^GMT(142.98,+GMTSUSR,1))  S GMTSDEF=$P($G(^GMT(142.98,+GMTSUSR,1)),"^",2) Q:'$L(GMTSDEF)

 N DIR,DIROUT,DIRUT,DTOUT,DUOUT,GMTSA S DIR("B")="N",(GMTSA,DIR("A"))="Delete '"_GMTSDEF_"'?  (Y/N)  " S:$D(GMTSEL("@")) DIR("A")="    "_GMTSA S:$D(GMTSORD("@")) DIR("A")="         "_GMTSA

 S:$D(GMTSCPL("@")) DIR("A")=" "_GMTSA K GMTSEL("@"),GMTSORD("@"),GMTSCPL("@")

 S DIR(0)="YAO" W ! D ^DIR S:+Y>0 $P(^GMT(142.98,+GMTSUSR,1),"^",2)=""

 Q

DP(X) ;   Delete Record of Inactive User

 N DA,DIK,DIC,DTOUT,DUOUT,GMTSUSR S GMTSUSR=+($G(X))

 S X=$$UNM^GMTSXAW3(+($G(GMTSUSR))) Q:'$L(X)

 S DIC="^GMT(142.98,",DIC(0)="M" D ^DIC I +Y>0 S DIK=DIC,DA=+Y D ^DIK

 Q

 ;            

 ; Miscellaneous

OLD(X) ;   Old Entry

 Q $$GET1^DIQ(142.98,+($G(GMTSUSR)),11)

ORT(X) ;   Total Entities Ordered

 N GMTSI S (X,GMTSI)=0 F  S GMTSI=$O(GMTSORD(GMTSI)) Q:+GMTSI=0  S X=X+1

 Q X

SLT(X) ;   Total Selected

 N GMTSI S (X,GMTSI)=0 F  S GMTSI=$O(GMTSEL(GMTSI)) Q:+GMTSI=0  S X=X+1

 Q X

PENT(GMTSUSR) ;   Get User Preference Entry

 N DIC,DTOUT,DUOUT,GMTSACT,DLAYGO S GMTSUSR=+($G(GMTSUSR)) Q:GMTSUSR=0 -1

 S GMTSACT=$$ACTIVE^XUSER(+GMTSUSR) D:+GMTSACT'>0 DP(GMTSUSR) Q:+GMTSACT'>0 -1

 S X=$$UNM^GMTSXAW3(+($G(GMTSUSR))) Q:'$L(X) -1

 S DIC="^GMT(142.98,",DIC(0)="LM",DLAYGO=142.98 D ^DIC

 S X=+($G(Y)) Q X

PIT(X) ;   Precedence Input Transform

 N GMTSIN S GMTSIN=$$UP^GMTSXA($G(X)) Q:GMTSIN="" 1 N GMTSC,GMTSI,GMTSA,GMTS S GMTSC="^NAT^SYS^USR^",GMTS="" F GMTSI=1:1 Q:GMTSI>$L(GMTSIN,";")  D

 . S GMTSA=$P($G(GMTSIN),";",GMTSI) Q:$L(GMTSA)'=3  Q:GMTSC'[("^"_GMTSA_"^")  Q:GMTS[(";"_GMTSA)  S GMTS=GMTS_";"_GMTSA

 S GMTS=$$TRIM^GMTSXA(GMTS,";",3),X=$S(GMTS=GMTSIN:1,1:0) Q X

USRD(X) ;   User Precedence/Default

 N GMTSUSR S GMTSUSR=$G(X),X=$P($G(^GMT(142.98,+($G(GMTSUSR)),1)),"^",2)

 S:X="" X=$$DEF^GMTSXAW(GMTSUSR) Q X

GMTSXAP2  ; SLC/KER - List Parameters/Precedence 2         ; 02/27/2002

 +1       ;;2.7;Health Summary;**47,49**;Oct 20, 1995

 +2        QUIT 

 +3       ;                          

 +4       ; External References in GMTSXAP2

 +5       ;    DBIA  2056  $$GET1^DIQ

 +6       ;    DBIA  2343  $$ACTIVE^XUSER

 +7       ;    DBIA 10006  ^DIC

 +8       ;    DBIA 10026  ^DIR

 +9       ;    DBIA 10018  ^DIE

 +10      ;    DBIA 10013  ^DIK

 +11      ;                        

 +12      ; Check to see if Compiled Order is correct

OK(X)     ;   Ask if Ok

 +1        NEW Y,DIR,GMTSTOT,GMTSOLD

           SET GMTSNEW=$GET(GMTSNEW)

           SET GMTSOLD=$$OLD

 +2        SET GMTSTOT=$$ORT

           IF GMTSTOT=1

               SET X=$$OKO

           IF GMTSTOT>1

               SET X=$$OKM

           IF GMTSTOT'>0

               SET X=0

 +3        QUIT X

OKM(X)    ;     Multiple entities selected     i.e. USR;SYS

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

           SET X=1

           DO OKA

           IF '$DATA(DIR)

               QUIT 0

 +2        DO YND

 +3        QUIT X

OKO(X)    ;     Only one entity selected       i.e. USR

 +1        IF '$LENGTH($GET(GMTSORD(1)))!($LENGTH($PIECE(GMTSORD(1),"^",1))'=3)!($LENGTH($PIECE(GMTSORD(1),"^",3))'>0)

               QUIT 0

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

           DO OKA

           IF '$DATA(DIR)

               QUIT 0

 +3        DO YND

 +4        QUIT X

OKA       ;   Set up Prompts - DIR("A")

 +1        NEW GMTSC,GMTSI,GMTST

           SET (GMTSC,GMTSI)=0

           SET GMTST=$$ORT

MUL       ;     Multiple Entities

 +1        IF GMTST>1

               Begin DoDot:1

 +2                KILL DIR

                   NEW GMTSTC,GMTSA,GMTSC

                   SET GMTSC=0

                   SET GMTSA=GMTST+4

                   SET GMTSTC=$SELECT(GMTST=2:"two",GMTST=3:"three",1:"several")

 +3                SET DIR("A",1)=""

                   SET DIR("A",2)=" You have selected "_GMTSTC_" Health Summary Types, arranged "

 +4                SET DIR("A",3)=" in the following order:"

                   SET DIR("A",4)=""

 +5                FOR GMTSA=1:1:GMTST

                       SET DIR("A",(4+GMTSA))="  "_$JUSTIFY(GMTSA,2)_"    "_$PIECE($GET(GMTSORD(+GMTSA)),"^",3)

 +6                SET GMTSA=+($ORDER(DIR("A"," "),-1))+1

                   SET DIR("A",GMTSA)=""

                   SET DIR("A")=" Is this precedence correct?  (Y/N)  "

                   SET DIR(0)="YAO"

                   SET DIR("B")="Y"

               End DoDot:1

               QUIT 

ONE       ;     One Entity

 +1        IF GMTST=1

               Begin DoDot:1

 +2                IF $LENGTH($GET(GMTSORD(1)))

                       IF $LENGTH($PIECE(GMTSORD(1),"^",1))=3

                           IF $LENGTH($PIECE(GMTSORD(1),"^",3))>0

                               Begin DoDot:2

 +3                                KILL DIR

                                   SET DIR("A",1)=""

 +4                                SET DIR("A",2)=" You have selected one Health Summary Type"

 +5                                SET DIR("A",3)=""

 +6                                SET DIR("A",4)="    "_$PIECE($GET(GMTSORD(1)),"^",3)

 +7                                SET DIR("A",5)=""

 +8                                SET DIR("A")=" Is this correct?  (Y/N)  "

 +9                                SET DIR(0)="YAO"

                                   SET DIR("B")="Y"

                               End DoDot:2

                               QUIT 

 +10               KILL DIR

               End DoDot:1

               QUIT 

 +11       KILL DIR

 +12       QUIT 

 +13      ;            

YND       ; Yes/No/Delete

 +1        WRITE !

           SET X=$GET(X)

           IF $LENGTH($GET(DIR("A")))

               SET DIR("A")=" Is this correct?  (Y/N)  "

 +2        SET (DIR("?"),DIR("??"))="^D YNDH^GMTSXAP2"

 +3        SET DIR(0)="FAO^1;3^K:$$YNDI^GMTSXAP2(X)'>0 X"

           SET DIR("B")="Y"

 +4        DO ^DIR

           SET X=$$YNDO(X)

           IF X["^"

               SET GMTSEXIT=1

           IF X="@"

               SET GMTSEXIT=1

               SET GMTSCPL("@")=""

 +5        IF X="N"&($LENGTH(GMTSNEW))&(GMTSNEW=GMTSOLD)

               SET GMTSEXIT=1

               SET GMTSCPL("@")=""

 +6        SET X=$SELECT(X="Y":1,X="N":0,1:-1)

 +7        QUIT 

YNDI(X)   ;   Input Transform

 +1        NEW GMTS

           SET GMTS=$$UP^GMTSXA($GET(X))

           IF $LENGTH(GMTS)&("^Y^YE^YES^N^NO^@^^^^^"'[("^"_GMTS_"^"))

               QUIT 0

           QUIT 1

YNDO(X)   ;   Output Transform

 +1        NEW GMTS

           SET GMTS=$$UP^GMTSXA($GET(X))

           SET X=$SELECT($EXTRACT(GMTS,1)="Y":"Y",$EXTRACT(GMTS,1)="N":"N",$EXTRACT(GMTS,1)="@":"@",GMTS["^^":"^^",1:"^")

 +2        SET X=$SELECT($DATA(DUOUT):"^",1:X)

           SET X=$SELECT($DATA(DTOUT):"^^",$DATA(DIROUT):"^^",1:X)

           QUIT X

YNDH      ;   Help

 +1        WRITE !,"    Enter either 'Y'es, 'N'o, or '^' to exit"

           QUIT 

 +2        QUIT 

 +3       ;            

EDIT(GMTSUXR,X) ; Edit "Append/Overwrite"

 +1        NEW DIC,DIE,DTOUT,DUOUT,Y,DR,DA,GMTSACT,GMTSDAT,GMTSPREF,GMTSA

 +2        SET GMTSDAT=$GET(X)

           SET GMTSUSR=+($GET(GMTSUSR))

           IF GMTSUSR=0

               QUIT 

           SET GMTSACT=$$ACTIVE^XUSER(+GMTSUSR)

           IF +GMTSACT'>0

               DO DP(GMTSUSR)

           IF +GMTSACT'>0

               QUIT 

 +3        SET GMTSPREF=$$PENT(GMTSUSR)

           IF +GMTSPREF'>0

               QUIT 

 +4        SET DIE="^GMT(142.98,"

           SET DA=+($GET(GMTSUSR))

           SET DR="11///^S X=GMTSDAT"

ED        ;   Lock Record, Edit Entry

 +1        LOCK +^GMT(142.98,+GMTSPREF):0

           IF $TEST

               DO ^DIE

               LOCK -^GMT(142.98,+GMTSPREF)

               QUIT 

 +2        SET GMTSA=+($GET(GMTSA))+1

           IF GMTSA>3

               QUIT 

           HANG 1

           GOTO ED

 +3        QUIT 

 +4       ;            

 +5       ; Deletions

ADEL      ;   Ask for Deletion of Precedence

 +1        NEW X,Y,GMTSU,GMTSACT,GMTSDEF

           SET GMTSU=$GET(GMTSUSR)

           SET GMTSACT=$$ACTIVE^XUSER(+GMTSU)

           IF +GMTSACT'>0

               DO DP(GMTSUSR)

           IF +GMTSACT'>0

               QUIT 

           SET X=$$UNM^GMTSXAW3(+($GET(GMTSUSR)))

           IF '$LENGTH(X)

               QUIT 

 +2        IF '$DATA(^GMT(142.98,+GMTSUSR,1))

               QUIT 

           SET GMTSDEF=$PIECE($GET(^GMT(142.98,+GMTSUSR,1)),"^",2)

           IF '$LENGTH(GMTSDEF)

               QUIT 

 +3        NEW DIR,DIROUT,DIRUT,DTOUT,DUOUT,GMTSA

           SET DIR("B")="N"

           SET (GMTSA,DIR("A"))="Delete '"_GMTSDEF_"'?  (Y/N)  "

           IF $DATA(GMTSEL("@"))

               SET DIR("A")="    "_GMTSA

           IF $DATA(GMTSORD("@"))

               SET DIR("A")="         "_GMTSA

 +4        IF $DATA(GMTSCPL("@"))

               SET DIR("A")=" "_GMTSA

           KILL GMTSEL("@"),GMTSORD("@"),GMTSCPL("@")

 +5        SET DIR(0)="YAO"

           WRITE !

           DO ^DIR

           IF +Y>0

               SET $PIECE(^GMT(142.98,+GMTSUSR,1),"^",2)=""

 +6        QUIT 

DP(X)     ;   Delete Record of Inactive User

 +1        NEW DA,DIK,DIC,DTOUT,DUOUT,GMTSUSR

           SET GMTSUSR=+($GET(X))

 +2        SET X=$$UNM^GMTSXAW3(+($GET(GMTSUSR)))

           IF '$LENGTH(X)

               QUIT 

 +3        SET DIC="^GMT(142.98,"

           SET DIC(0)="M"

           DO ^DIC

           IF +Y>0

               SET DIK=DIC

               SET DA=+Y

               DO ^DIK

 +4        QUIT 

 +5       ;            

 +6       ; Miscellaneous

OLD(X)    ;   Old Entry

 +1        QUIT $$GET1^DIQ(142.98,+($GET(GMTSUSR)),11)

ORT(X)    ;   Total Entities Ordered

 +1        NEW GMTSI

           SET (X,GMTSI)=0

           FOR 

               SET GMTSI=$ORDER(GMTSORD(GMTSI))

               IF +GMTSI=0

                   QUIT 

               SET X=X+1

 +2        QUIT X

SLT(X)    ;   Total Selected

 +1        NEW GMTSI

           SET (X,GMTSI)=0

           FOR 

               SET GMTSI=$ORDER(GMTSEL(GMTSI))

               IF +GMTSI=0

                   QUIT 

               SET X=X+1

 +2        QUIT X

PENT(GMTSUSR) ;   Get User Preference Entry

 +1        NEW DIC,DTOUT,DUOUT,GMTSACT,DLAYGO

           SET GMTSUSR=+($GET(GMTSUSR))

           IF GMTSUSR=0

               QUIT -1

 +2        SET GMTSACT=$$ACTIVE^XUSER(+GMTSUSR)

           IF +GMTSACT'>0

               DO DP(GMTSUSR)

           IF +GMTSACT'>0

               QUIT -1

 +3        SET X=$$UNM^GMTSXAW3(+($GET(GMTSUSR)))

           IF '$LENGTH(X)

               QUIT -1

 +4        SET DIC="^GMT(142.98,"

           SET DIC(0)="LM"

           SET DLAYGO=142.98

           DO ^DIC

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

           QUIT X

PIT(X)    ;   Precedence Input Transform

 +1        NEW GMTSIN

           SET GMTSIN=$$UP^GMTSXA($GET(X))

           IF GMTSIN=""

               QUIT 1

           NEW GMTSC,GMTSI,GMTSA,GMTS

           SET GMTSC="^NAT^SYS^USR^"

           SET GMTS=""

           FOR GMTSI=1:1

               IF GMTSI>$LENGTH(GMTSIN,";")

                   QUIT 

               Begin DoDot:1

 +2                SET GMTSA=$PIECE($GET(GMTSIN),";",GMTSI)

                   IF $LENGTH(GMTSA)'=3

                       QUIT 

                   IF GMTSC'[("^"_GMTSA_"^")

                       QUIT 

                   IF GMTS[(";"_GMTSA)

                       QUIT 

                   SET GMTS=GMTS_";"_GMTSA

               End DoDot:1

 +3        SET GMTS=$$TRIM^GMTSXA(GMTS,";",3)

           SET X=$SELECT(GMTS=GMTSIN:1,1:0)

           QUIT X

USRD(X)   ;   User Precedence/Default

 +1        NEW GMTSUSR

           SET GMTSUSR=$GET(X)

           SET X=$PIECE($GET(^GMT(142.98,+($GET(GMTSUSR)),1)),"^",2)

 +2        IF X=""

               SET X=$$DEF^GMTSXAW(GMTSUSR)

           QUIT X