source: WorldVistAEHR/trunk/r/PROBLEM_LIST-GMPL/GMPLPREF.m@ 861

Last change on this file since 861 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 4.3 KB
RevLine 
[613]1GMPLPREF ; SLC/MKB -- Problem List User Preferences ;2/1/96 12:31
2 ;;2.0;Problem List;**3,5**;Aug 25, 1994
3EN ; -- main entry point for GMPL USER PREFS
4 D CURRENT^GMPLPRF0(DUZ) Q:'$$CHANGE^GMPLPRF0
5 D EN^VALM("GMPL USER PREFS")
6 Q
7 ;
8INIT ; -- init variables and list array
9 S GMPLVIEW=$P($G(^VA(200,DUZ,125)),U),GMPLMODE=$E(GMPLVIEW) ; 'S' or 'C'
10 S GMPLMODE=$$VIEW^GMPLPRF0(GMPLMODE)
11 I GMPLMODE="^" K GMPLVIEW,GMPLMODE S VALMQUIT=1 Q
12 I $$ALL^GMPLPRF0(GMPLMODE,$L(GMPLVIEW,"/")) D SAVE^GMPLPRF1 W !!,"Preferred View saved.",! H 1 S VALMQUIT=1 Q
13 D GETSLIST:GMPLMODE="S",GETCLIST:GMPLMODE'="S"
14 Q
15 ;
16GETSLIST ; -- init SERVICE list array
17 N LCNT,IFN,NAME,PARENT K ^TMP("GMPLIST",$J) S LCNT=0,^TMP("GMPLIST",$J,"VIEW",0)=0
18 W !!,"Retrieving the list of clinical services ..."
19 F IFN=0:0 S IFN=$O(^DIC(49,"F","C",IFN)) Q:IFN'>0 D
20 . Q:$D(^TMP("GMPLIST",$J,"B",IFN)) ; service already on list
21 . 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
22 . S NAME=$P($G(^DIC(49,IFN,0)),U)
23 . D ITEM(IFN,NAME,GMPLVIEW,.LCNT)
24 . Q:'$D(^DIC(49,"ACHLD",IFN)) ; service has no 'children'
25 . F CHILD=0:0 S CHILD=$O(^DIC(49,"ACHLD",IFN,CHILD)) Q:CHILD'>0 I CHILD'=IFN D
26 . . S NAME=" "_$P($G(^DIC(49,CHILD,0)),U)
27 . . D ITEM(CHILD,NAME,GMPLVIEW,.LCNT)
28 I LCNT'>0 S ^TMP("GMPLIST",$J,1,0)=" ",^TMP("GMPLIST",$J,2,0)=" No clinical services available to select from."
29 D:$P(VALMDDF("SERVICE"),U,4)'="Service" CHGCAP^VALM("SERVICE","Service")
30 S VALMCNT=LCNT,^TMP("GMPLIST",$J,0)=VALMCNT,VALMSG=$$MSG
31 Q
32 ;
33GETCLIST ; -- init CLINIC list array
34 N LCNT,IFN,NAME K ^TMP("GMPLIST",$J) S LCNT=0,^TMP("GMPLIST",$J,"VIEW",0)=0
35 W !!,"Retrieving the list of clinics ..."
36 F IFN=0:0 S IFN=$O(^SC(IFN)) Q:IFN'>0 D
37 . S NODE=$G(^SC(IFN,0)) Q:$P(NODE,U,3)'="C" ; loc not a clinic
38 . S NAME=$P(NODE,U) D ITEM(IFN,NAME,GMPLVIEW,.LCNT)
39 I LCNT'>0 S ^TMP("GMPLIST",$J,1,0)=" ",^TMP("GMPLIST",$J,2,0)=" No clinics available to select from."
40 D:$P(VALMDDF("SERVICE"),U,4)'="Clinic" CHGCAP^VALM("SERVICE","Clinic")
41 S VALMCNT=LCNT,^TMP("GMPLIST",$J,0)=VALMCNT,VALMSG=$$MSG
42 Q
43 ;
44ITEM(IFN,NAME,VIEW,CNT) ;Add item to list display
45 N LNG,TMP,LINE,INCL S INCL=VIEW[("/"_IFN_"/")
46 S LINE=" . . . . . . . . . . . . . . . . . . . . "
47 S CNT=CNT+1,LINE=$$SETFLD^VALM1(CNT,LINE,"NUMBER")
48 S LNG=4+$L(NAME),TMP=$E(LINE,1,4)_NAME_$E(LINE,LNG+1,$L(LINE)),LINE=TMP
49 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
50 S ^TMP("GMPLIST",$J,CNT,0)=LINE,^TMP("GMPLIST",$J,"IDX",CNT)=IFN,^TMP("GMPLIST",$J,"B",IFN)=CNT
51 D CNTRL^VALM10(CNT,1,2,IOINHI,IOINORM) ; highlight numbers
52 Q
53 ;
54HDR ; -- header code
55 N NUM,USER,X S USER=$P($G(^VA(200,DUZ,0)),U)
56 S X="CLINIC"_$S(GMPLMODE="S":"AL SERVICE",1:"")_"S"
57 S NUM=+$G(^TMP("GMPLIST",$J,"VIEW",0))_" "_$S(GMPLMODE="S":"services",1:"clinics")
58 S VALMHDR(1)=USER_$J(NUM,79-$L(USER)),VALMHDR(2)=$J(X,$L(X)\2+41)
59 Q
60 ;
61HELP ; -- help code
62 N X,Y S:GMPLMODE="S" X="services",Y="clinics"
63 S:GMPLMODE'="S" X="clinics",Y="services"
64 W !!?4,"To create or change your preferred view, choose either Add or"
65 W !?4,"Remove; those "_X_" you add will be flagged above with a 'Y'."
66 W !?4,"Within the Problem List application, ONLY those problems associated"
67 W !?4,"with your selected "_X_" will initially be displayed, however"
68 W !?4,"the entire list is always available using its Select View option."
69 W !?4,"If you wish to create a view according to "_Y_" instead, or not"
70 W !?4,"to have a view at all, choose Select New View or Delete respectively."
71 W !!,"Press <return> to continue ... " R X:DTIME
72 S VALMSG=$$MSG,VALMBCK=$S(VALMCC:"",1:"R")
73 Q
74 ;
75CLEAN ; -- exit code
76 I $$DIFFRENT^GMPLPRF1,'$D(GMPSAVED) D
77 . N DIR,X,Y S DIR(0)="Y"
78 . W !!,$C(7),">>> YOUR PREFERRED VIEW HAS CHANGED!!"
79 . S DIR("A")="Do you want to save these changes",DIR("B")="YES"
80 . S DIR("?",1)="Enter YES to have only problems from the "_$S(GMPLMODE="S":"service",1:"clinic")_"s indicated above"
81 . S DIR("?",2)="listed, when initially displaying a patient's problem list;"
82 . S DIR("?")="enter NO to retain your previous view."
83 . D ^DIR D:Y SAVE^GMPLPRF1
84 K GMPLVIEW,GMPLIST,GMPLMODE,GMPSAVED
85 K ^TMP("GMPLIST",$J)
86 K VALMHDR,VALMCNT,VALMSG,VALMBCK
87 Q
88 ;
89MSG() ; -- msg line for more help
90 N X S X="+ More "_$S(GMPLMODE="S":"Services",1:"Clinics")_" ?? More actions"
91 Q X
Note: See TracBrowser for help on using the repository browser.