Routine: GMPLPREF

GMPLPREF ; SLC/MKB -- Problem List User Preferences ;2/1/96  12:31

 ;;2.0;Problem List;**3,5**;Aug 25, 1994

EN ; -- main entry point for GMPL USER PREFS

 D CURRENT^GMPLPRF0(DUZ) Q:'$$CHANGE^GMPLPRF0

 D EN^VALM("GMPL USER PREFS")

INIT ; -- init variables and list array

 S GMPLVIEW=$P($G(^VA(200,DUZ,125)),U),GMPLMODE=$E(GMPLVIEW) ; 'S' or 'C'

 S GMPLMODE=$$VIEW^GMPLPRF0(GMPLMODE)

 I GMPLMODE="^" K GMPLVIEW,GMPLMODE S VALMQUIT=1 Q

 I $$ALL^GMPLPRF0(GMPLMODE,$L(GMPLVIEW,"/")) D SAVE^GMPLPRF1 W !!,"Preferred View saved.",! H 1 S VALMQUIT=1 Q

 D GETSLIST:GMPLMODE="S",GETCLIST:GMPLMODE'="S"

GETSLIST ; -- init SERVICE list array

 N LCNT,IFN,NAME,PARENT K ^TMP("GMPLIST",$J) S LCNT=0,^TMP("GMPLIST",$J,"VIEW",0)=0

 W !!,"Retrieving the list of clinical services ..."

 F IFN=0:0 S IFN=$O(^DIC(49,"F","C",IFN)) Q:IFN'>0  D

 . Q:$D(^TMP("GMPLIST",$J,"B",IFN))  ; service already on list

 . S PARENT=+$P($G(^DIC(49,IFN,0)),U,4) I PARENT,PARENT'=IFN,$D(^DIC(49,"F","C",PARENT)) Q  ; child of clin service

 . S NAME=$P($G(^DIC(49,IFN,0)),U)

 . D ITEM(IFN,NAME,GMPLVIEW,.LCNT)

 . Q:'$D(^DIC(49,"ACHLD",IFN))  ; service has no 'children'

 . F CHILD=0:0 S CHILD=$O(^DIC(49,"ACHLD",IFN,CHILD)) Q:CHILD'>0  I CHILD'=IFN D

 . . S NAME="  "_$P($G(^DIC(49,CHILD,0)),U)

 . . D ITEM(CHILD,NAME,GMPLVIEW,.LCNT)

 I LCNT'>0 S ^TMP("GMPLIST",$J,1,0)="   ",^TMP("GMPLIST",$J,2,0)="    No clinical services available to select from."

 D:$P(VALMDDF("SERVICE"),U,4)'="Service" CHGCAP^VALM("SERVICE","Service")

 S VALMCNT=LCNT,^TMP("GMPLIST",$J,0)=VALMCNT,VALMSG=$$MSG

GETCLIST ; -- init CLINIC list array

 N LCNT,IFN,NAME K ^TMP("GMPLIST",$J) S LCNT=0,^TMP("GMPLIST",$J,"VIEW",0)=0

 W !!,"Retrieving the list of clinics ..."

 F IFN=0:0 S IFN=$O(^SC(IFN)) Q:IFN'>0  D

 . S NODE=$G(^SC(IFN,0)) Q:$P(NODE,U,3)'="C"  ; loc not a clinic

 . S NAME=$P(NODE,U) D ITEM(IFN,NAME,GMPLVIEW,.LCNT)

 I LCNT'>0 S ^TMP("GMPLIST",$J,1,0)="   ",^TMP("GMPLIST",$J,2,0)="    No clinics available to select from."

 D:$P(VALMDDF("SERVICE"),U,4)'="Clinic" CHGCAP^VALM("SERVICE","Clinic")

 S VALMCNT=LCNT,^TMP("GMPLIST",$J,0)=VALMCNT,VALMSG=$$MSG

ITEM(IFN,NAME,VIEW,CNT) ;Add item to list display

 N LNG,TMP,LINE,INCL S INCL=VIEW[("/"_IFN_"/")

 S LINE="    . . . . . . . . . . . . . . . . . . . . "

 S CNT=CNT+1,LINE=$$SETFLD^VALM1(CNT,LINE,"NUMBER")

 S LNG=4+$L(NAME),TMP=$E(LINE,1,4)_NAME_$E(LINE,LNG+1,$L(LINE)),LINE=TMP

 I INCL S LINE=$$SETFLD^VALM1(" Y",LINE,"ACCEPT"),^TMP("GMPLIST",$J,"VIEW",IFN)="",^TMP("GMPLIST",$J,"VIEW",0)=^TMP("GMPLIST",$J,"VIEW",0)+1

 S ^TMP("GMPLIST",$J,CNT,0)=LINE,^TMP("GMPLIST",$J,"IDX",CNT)=IFN,^TMP("GMPLIST",$J,"B",IFN)=CNT

 D CNTRL^VALM10(CNT,1,2,IOINHI,IOINORM) ; highlight numbers

HDR ; -- header code

 N NUM,USER,X S USER=$P($G(^VA(200,DUZ,0)),U)

 S X="CLINIC"_$S(GMPLMODE="S":"AL SERVICE",1:"")_"S"

 S NUM=+$G(^TMP("GMPLIST",$J,"VIEW",0))_" "_$S(GMPLMODE="S":"services",1:"clinics")

 S VALMHDR(1)=USER_$J(NUM,79-$L(USER)),VALMHDR(2)=$J(X,$L(X)\2+41)

HELP ; -- help code

 N X,Y S:GMPLMODE="S" X="services",Y="clinics"

 S:GMPLMODE'="S" X="clinics",Y="services"

 W !!?4,"To create or change your preferred view, choose either Add or"

 W !?4,"Remove; those "_X_" you add will be flagged above with a 'Y'."

 W !?4,"Within the Problem List application, ONLY those problems associated"

 W !?4,"with your selected "_X_" will initially be displayed, however"

 W !?4,"the entire list is always available using its Select View option."

 W !?4,"If you wish to create a view according to "_Y_" instead, or not"

 W !?4,"to have a view at all, choose Select New View or Delete respectively."

 W !!,"Press <return> to continue ... " R X:DTIME

 S VALMSG=$$MSG,VALMBCK=$S(VALMCC:"",1:"R")

CLEAN ; -- exit code

 I $$DIFFRENT^GMPLPRF1,'$D(GMPSAVED) D

 . N DIR,X,Y S DIR(0)="Y"

 . W !!,$C(7),">>>  YOUR PREFERRED VIEW HAS CHANGED!!"

 . S DIR("A")="Do you want to save these changes",DIR("B")="YES"

 . S DIR("?",1)="Enter YES to have only problems from the "_$S(GMPLMODE="S":"service",1:"clinic")_"s indicated above"

 . S DIR("?",2)="listed, when initially displaying a patient's problem list;"

 . S DIR("?")="enter NO to retain your previous view."

 . D ^DIR D:Y SAVE^GMPLPRF1

 K GMPLVIEW,GMPLIST,GMPLMODE,GMPSAVED

 K ^TMP("GMPLIST",$J)

 K VALMHDR,VALMCNT,VALMSG,VALMBCK

MSG() ; -- msg line for more help

 N X S X="+ More "_$S(GMPLMODE="S":"Services",1:"Clinics")_"   ?? More actions"

Q X

GMPLPREF  ; SLC/MKB -- Problem List User Preferences ;2/1/96  12:31

 +1       ;;2.0;Problem List;**3,5**;Aug 25, 1994

EN        ; -- main entry point for GMPL USER PREFS

 +1        DO CURRENT^GMPLPRF0(DUZ)

           IF '$$CHANGE^GMPLPRF0

               QUIT

 +2        DO EN^VALM("GMPL USER PREFS")

 +3        QUIT

 +4       ;

INIT      ; -- init variables and list array

 +1       ; 'S' or 'C'

           SET GMPLVIEW=$PIECE($GET(^VA(200,DUZ,125)),U)

           SET GMPLMODE=$EXTRACT(GMPLVIEW)

 +2        SET GMPLMODE=$$VIEW^GMPLPRF0(GMPLMODE)

 +3        IF GMPLMODE="^"

               KILL GMPLVIEW,GMPLMODE

               SET VALMQUIT=1

               QUIT

 +4        IF $$ALL^GMPLPRF0(GMPLMODE,$LENGTH(GMPLVIEW,"/"))

               DO SAVE^GMPLPRF1

               WRITE !!,"Preferred View saved.",!

               HANG 1

               SET VALMQUIT=1

               QUIT

 +5        IF GMPLMODE="S"

               DO GETSLIST

           IF GMPLMODE'="S"

               DO GETCLIST

 +6        QUIT

 +7       ;

GETSLIST  ; -- init SERVICE list array

 +1        NEW LCNT,IFN,NAME,PARENT

           KILL ^TMP("GMPLIST",$JOB)

           SET LCNT=0

           SET ^TMP("GMPLIST",$JOB,"VIEW",0)=0

 +2        WRITE !!,"Retrieving the list of clinical services ..."

 +3        FOR IFN=0:0

               SET IFN=$ORDER(^DIC(49,"F","C",IFN))

               IF IFN'>0

                   QUIT

               Begin DoDot:1

 +4       ; service already on list

                   IF $DATA(^TMP("GMPLIST",$JOB,"B",IFN))

                       QUIT

 +5       ; child of clin service

                   SET PARENT=+$PIECE($GET(^DIC(49,IFN,0)),U,4)

                   IF PARENT

                       IF PARENT'=IFN

                           IF $DATA(^DIC(49,"F","C",PARENT))

                               QUIT

 +6                SET NAME=$PIECE($GET(^DIC(49,IFN,0)),U)

 +7                DO ITEM(IFN,NAME,GMPLVIEW,.LCNT)

 +8       ; service has no 'children'

                   IF '$DATA(^DIC(49,"ACHLD",IFN))

                       QUIT

 +9                FOR CHILD=0:0

                       SET CHILD=$ORDER(^DIC(49,"ACHLD",IFN,CHILD))

                       IF CHILD'>0

                           QUIT

                       IF CHILD'=IFN

                           Begin DoDot:2

 +10                           SET NAME="  "_$PIECE($GET(^DIC(49,CHILD,0)),U)

 +11                           DO ITEM(CHILD,NAME,GMPLVIEW,.LCNT)

                           End DoDot:2

               End DoDot:1

 +12       IF LCNT'>0

               SET ^TMP("GMPLIST",$JOB,1,0)="   "

               SET ^TMP("GMPLIST",$JOB,2,0)="    No clinical services available to select from."

 +13       IF $PIECE(VALMDDF("SERVICE"),U,4)'="Service"

               DO CHGCAP^VALM("SERVICE","Service")

 +14       SET VALMCNT=LCNT

           SET ^TMP("GMPLIST",$JOB,0)=VALMCNT

           SET VALMSG=$$MSG

 +15       QUIT

 +16      ;

GETCLIST  ; -- init CLINIC list array

 +1        NEW LCNT,IFN,NAME

           KILL ^TMP("GMPLIST",$JOB)

           SET LCNT=0

           SET ^TMP("GMPLIST",$JOB,"VIEW",0)=0

 +2        WRITE !!,"Retrieving the list of clinics ..."

 +3        FOR IFN=0:0

               SET IFN=$ORDER(^SC(IFN))

               IF IFN'>0

                   QUIT

               Begin DoDot:1

 +4       ; loc not a clinic

                   SET NODE=$GET(^SC(IFN,0))

                   IF $PIECE(NODE,U,3)'="C"

                       QUIT

 +5                SET NAME=$PIECE(NODE,U)

                   DO ITEM(IFN,NAME,GMPLVIEW,.LCNT)

               End DoDot:1

 +6        IF LCNT'>0

               SET ^TMP("GMPLIST",$JOB,1,0)="   "

               SET ^TMP("GMPLIST",$JOB,2,0)="    No clinics available to select from."

 +7        IF $PIECE(VALMDDF("SERVICE"),U,4)'="Clinic"

               DO CHGCAP^VALM("SERVICE","Clinic")

 +8        SET VALMCNT=LCNT

           SET ^TMP("GMPLIST",$JOB,0)=VALMCNT

           SET VALMSG=$$MSG

 +9        QUIT

 +10      ;

ITEM(IFN,NAME,VIEW,CNT) ;Add item to list display

 +1        NEW LNG,TMP,LINE,INCL

           SET INCL=VIEW[("/"_IFN_"/")

 +2        SET LINE="    . . . . . . . . . . . . . . . . . . . . "

 +3        SET CNT=CNT+1

           SET LINE=$$SETFLD^VALM1(CNT,LINE,"NUMBER")

 +4        SET LNG=4+$LENGTH(NAME)

           SET TMP=$EXTRACT(LINE,1,4)_NAME_$EXTRACT(LINE,LNG+1,$LENGTH(LINE))

           SET LINE=TMP

 +5        IF INCL

               SET LINE=$$SETFLD^VALM1(" Y",LINE,"ACCEPT")

               SET ^TMP("GMPLIST",$JOB,"VIEW",IFN)=""

               SET ^TMP("GMPLIST",$JOB,"VIEW",0)=^TMP("GMPLIST",$JOB,"VIEW",0)+1

 +6        SET ^TMP("GMPLIST",$JOB,CNT,0)=LINE

           SET ^TMP("GMPLIST",$JOB,"IDX",CNT)=IFN

           SET ^TMP("GMPLIST",$JOB,"B",IFN)=CNT

 +7       ; highlight numbers

           DO CNTRL^VALM10(CNT,1,2,IOINHI,IOINORM)

 +8        QUIT

 +9       ;

HDR       ; -- header code

 +1        NEW NUM,USER,X

           SET USER=$PIECE($GET(^VA(200,DUZ,0)),U)

 +2        SET X="CLINIC"_$SELECT(GMPLMODE="S":"AL SERVICE",1:"")_"S"

 +3        SET NUM=+$GET(^TMP("GMPLIST",$JOB,"VIEW",0))_" "_$SELECT(GMPLMODE="S":"services",1:"clinics")

 +4        SET VALMHDR(1)=USER_$JUSTIFY(NUM,79-$LENGTH(USER))

           SET VALMHDR(2)=$JUSTIFY(X,$LENGTH(X)\2+41)

 +5        QUIT

 +6       ;

HELP      ; -- help code

 +1        NEW X,Y

           IF GMPLMODE="S"

               SET X="services"

               SET Y="clinics"

 +2        IF GMPLMODE'="S"

               SET X="clinics"

               SET Y="services"

 +3        WRITE !!?4,"To create or change your preferred view, choose either Add or"

 +4        WRITE !?4,"Remove; those "_X_" you add will be flagged above with a 'Y'."

 +5        WRITE !?4,"Within the Problem List application, ONLY those problems associated"

 +6        WRITE !?4,"with your selected "_X_" will initially be displayed, however"

 +7        WRITE !?4,"the entire list is always available using its Select View option."

 +8        WRITE !?4,"If you wish to create a view according to "_Y_" instead, or not"

 +9        WRITE !?4,"to have a view at all, choose Select New View or Delete respectively."

 +10       WRITE !!,"Press <return> to continue ... "

           READ X:DTIME

 +11       SET VALMSG=$$MSG

           SET VALMBCK=$SELECT(VALMCC:"",1:"R")

 +12       QUIT

 +13      ;

CLEAN     ; -- exit code

 +1        IF $$DIFFRENT^GMPLPRF1

               IF '$DATA(GMPSAVED)

                   Begin DoDot:1

 +2                    NEW DIR,X,Y

                       SET DIR(0)="Y"

 +3                    WRITE !!,$CHAR(7),">>>  YOUR PREFERRED VIEW HAS CHANGED!!"

 +4                    SET DIR("A")="Do you want to save these changes"

                       SET DIR("B")="YES"

 +5                    SET DIR("?",1)="Enter YES to have only problems from the "_$SELECT(GMPLMODE="S":"service",1:"clinic")_"s indicated above"

 +6                    SET DIR("?",2)="listed, when initially displaying a patient's problem list;"

 +7                    SET DIR("?")="enter NO to retain your previous view."

 +8                    DO ^DIR

                       IF Y

                           DO SAVE^GMPLPRF1

                   End DoDot:1

 +9        KILL GMPLVIEW,GMPLIST,GMPLMODE,GMPSAVED

 +10       KILL ^TMP("GMPLIST",$JOB)

 +11       KILL VALMHDR,VALMCNT,VALMSG,VALMBCK

 +12       QUIT

 +13      ;

MSG()     ; -- msg line for more help

 +1        NEW X

           SET X="+ More "_$SELECT(GMPLMODE="S":"Services",1:"Clinics")_"   ?? More actions"

 +2        QUIT X

GMPLPREF.m