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")
Q
;
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"
Q
;
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
Q
;
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
Q
;
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
Q
;
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)
Q
;
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")
Q
;
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
Q
;
MSG() ; -- msg line for more help
N X S X="+ More "_$S(GMPLMODE="S":"Services",1:"Clinics")_" ?? More actions"
Q X
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HGMPLPREF 4502 printed Nov 22, 2024@17:40:18 Page 2
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
