GMTSXAO.m

GMTSXAO ; SLC/KER - List Parameters/Overwrite             ; 02/27/2002

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

 Q

 ;                        

 ; External References

 ;    DBIA  2343  $$ACTIVE^XUSER

 ;    DBIA 10006  ^DIC

 ;    DBIA 10026  ^DIR

 ;    DBIA 10018  ^DIE

 ;    DBIA 10013  ^DIK

 ;                        

EN ; Main Entry Point for Health Summary

 N GMTSUSR,GMTSACT S GMTSUSR=+($G(DUZ)) D PREF Q

 ;

EN2(X) ; Entry Point for User

 N GMTSUSR,GMTSACT S GMTSUSR=+($G(X)) D PREF Q

 ;                                   

EN3 ; Entry Point for Site

 N X,GMTSALW,GMTSPRE,GMTSCPL,GMTSUSR,GMTSACT,GMTSEL S GMTSUSR=.5

 D EN2^GMTSXAW(+($G(GMTSUSR))) S:$L($G(GMTSALW("ALLOWABLE")))>2 GMTSEL=$G(GMTSALW("ALLOWABLE"))

 Q:'$L($G(GMTSEL))  S X=$$CPL(GMTSEL),X=$S(X="O":0,X="A":1,1:"")

 S:$L(X) ^GMT(142.98,"ASITE")=X

 Q

PREF ; Get Preference - Append/Overwrite

 Q:'$L($$UNM^GMTSXAW3(+($G(GMTSUSR))))  S GMTSACT=$$ACTIVE^XUSER(+GMTSUSR) D:+GMTSACT'>0 DP(GMTSUSR) Q:+GMTSACT'>0 

 N GMTSEL,GMTSALW,GMTSPRE,GMTSCPL S GMTSEL=$P($G(^GMT(142.98,+($G(GMTSUSR)),1)),"^",2)

 D EN2^GMTSXAW(+($G(GMTSUSR))) S:'$L(GMTSEL)&($L($G(GMTSALW("ALLOWABLE")))>2) GMTSEL=$G(GMTSALW("ALLOWABLE"))_";NAT"

 S X=$$CPL(GMTSEL),X=$S(X="O":0,X="A":1,1:"") D:$L(X) EDIT(GMTSUSR,X)

 Q

 ;            

CPL(X) ; Compile List (Append or Overwrite)

 Q:'$L($G(X)) 0  Q:$L($G(X),";")<2 0

 N Y,DIR,DTOUT,DUOUT,DIRUT,DIROUT,GMTSPRE,GMTSI,GMTST,GMTSA,GMTSO S GMTSPRE=$G(X)

 I +($G(GMTSUSR))'=.5 D

 . W !!,"Default Method for building 'Health Summary Types'"

 . W !,"List on the CPRS Reports Tab",!

 I +($G(GMTSUSR))=.5 D

 . W !!,"Site Default Method for building 'Health Summary Types'"

 . W !,"List on the CPRS Reports Tab",!

 W !,?3,"Append selected Health Summary Types to the list",!,?3,"Overwrite selected Health Summary Types to the list",!

 S DIR(0)="SAO^A:Append;O:Overwrite",DIR("A")="Select Append/Overwrite (A/O):  "

 S DIR("B")="A",DIR("?")="^D EN1^GMTSXAC",DIR("??")="^D EN2^GMTSXAC"

 D ^DIR S X=Y

 Q X

 ;                                 

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="10///^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

 ;                           

 ; Miscellaneous

PENT(GMTSUSR) ;   Get User Preferred 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

DP(X) ;   Delete User Preferece of Inactive User

 N DA,DIK,DIC,DTOUT,DUOUT,GMTSUSR S GMTSUSR=+($G(X)),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

GMTSXAO   ; SLC/KER - List Parameters/Overwrite             ; 02/27/2002

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

 +2        QUIT 

 +3       ;                        

 +4       ; External References

 +5       ;    DBIA  2343  $$ACTIVE^XUSER

 +6       ;    DBIA 10006  ^DIC

 +7       ;    DBIA 10026  ^DIR

 +8       ;    DBIA 10018  ^DIE

 +9       ;    DBIA 10013  ^DIK

 +10      ;                        

EN        ; Main Entry Point for Health Summary

 +1        NEW GMTSUSR,GMTSACT

           SET GMTSUSR=+($GET(DUZ))

           DO PREF

           QUIT 

 +2       ;

EN2(X)    ; Entry Point for User

 +1        NEW GMTSUSR,GMTSACT

           SET GMTSUSR=+($GET(X))

           DO PREF

           QUIT 

 +2       ;                                   

EN3       ; Entry Point for Site

 +1        NEW X,GMTSALW,GMTSPRE,GMTSCPL,GMTSUSR,GMTSACT,GMTSEL

           SET GMTSUSR=.5

 +2        DO EN2^GMTSXAW(+($GET(GMTSUSR)))

           IF $LENGTH($GET(GMTSALW("ALLOWABLE")))>2

               SET GMTSEL=$GET(GMTSALW("ALLOWABLE"))

 +3        IF '$LENGTH($GET(GMTSEL))

               QUIT 

           SET X=$$CPL(GMTSEL)

           SET X=$SELECT(X="O":0,X="A":1,1:"")

 +4        IF $LENGTH(X)

               SET ^GMT(142.98,"ASITE")=X

 +5        QUIT 

PREF      ; Get Preference - Append/Overwrite

 +1        IF '$LENGTH($$UNM^GMTSXAW3(+($GET(GMTSUSR))))

               QUIT 

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

           IF +GMTSACT'>0

               DO DP(GMTSUSR)

           IF +GMTSACT'>0

               QUIT 

 +2        NEW GMTSEL,GMTSALW,GMTSPRE,GMTSCPL

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

 +3        DO EN2^GMTSXAW(+($GET(GMTSUSR)))

           IF '$LENGTH(GMTSEL)&($LENGTH($GET(GMTSALW("ALLOWABLE")))>2)

               SET GMTSEL=$GET(GMTSALW("ALLOWABLE"))_";NAT"

 +4        SET X=$$CPL(GMTSEL)

           SET X=$SELECT(X="O":0,X="A":1,1:"")

           IF $LENGTH(X)

               DO EDIT(GMTSUSR,X)

 +5        QUIT 

 +6       ;            

CPL(X)    ; Compile List (Append or Overwrite)

 +1        IF '$LENGTH($GET(X))

               QUIT 0

           IF $LENGTH($GET(X),";")<2

               QUIT 0

 +2        NEW Y,DIR,DTOUT,DUOUT,DIRUT,DIROUT,GMTSPRE,GMTSI,GMTST,GMTSA,GMTSO

           SET GMTSPRE=$GET(X)

 +3        IF +($GET(GMTSUSR))'=.5

               Begin DoDot:1

 +4                WRITE !!,"Default Method for building 'Health Summary Types'"

 +5                WRITE !,"List on the CPRS Reports Tab",!

               End DoDot:1

 +6        IF +($GET(GMTSUSR))=.5

               Begin DoDot:1

 +7                WRITE !!,"Site Default Method for building 'Health Summary Types'"

 +8                WRITE !,"List on the CPRS Reports Tab",!

               End DoDot:1

 +9        WRITE !,?3,"Append selected Health Summary Types to the list",!,?3,"Overwrite selected Health Summary Types to the list",!

 +10       SET DIR(0)="SAO^A:Append;O:Overwrite"

           SET DIR("A")="Select Append/Overwrite (A/O):  "

 +11       SET DIR("B")="A"

           SET DIR("?")="^D EN1^GMTSXAC"

           SET DIR("??")="^D EN2^GMTSXAC"

 +12       DO ^DIR

           SET X=Y

 +13       QUIT X

 +14      ;                                 

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 

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

           IF +GMTSACT'>0

               DO DP(GMTSUSR)

           IF +GMTSACT'>0

               QUIT 

 +4        SET GMTSPREF=$$PENT(GMTSUSR)

           IF +GMTSPREF'>0

               QUIT 

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

           SET DA=+($GET(GMTSUSR))

           SET DR="10///^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       ; Miscellaneous

PENT(GMTSUSR) ;   Get User Preferred 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

DP(X)     ;   Delete User Preferece of Inactive User

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

           SET GMTSUSR=+($GET(X))

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

           IF '$LENGTH(X)

               QUIT 

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

           SET DIC(0)="M"

           DO ^DIC

           IF +Y>0

               SET DIK=DIC

               SET DA=+Y

               DO ^DIK

 +3        QUIT