source: FOIAVistA/trunk/r/CLINICAL_REMINDERS-PXRM/PXRMRLST.m@ 794

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

initial load of FOIAVistA 6/30/08 version

File size: 3.6 KB
Line 
1PXRMRLST ; SLC/PKR - Clinical Reminder definition list. ;01/03/2005
2 ;;2.0;CLINICAL REMINDERS;;Feb 04, 2005
3 ;
4 ;==================================================
5 ;Build the criteria for which reminders to list.
6LIST N ALL,CRITERIA,DIR,DIROUT,DIRUT,DTOUT,DUOUT,IND
7 N LOCAL,LPREFIX,NCRIT,PREFIX,SORT,STATUS,X,Y
8START S (ALL,LOCAL,NCRIT)=0
9 S (PREFIX,STATUS)=""
10 ;
11ALLQ S DIR(0)="YAO"
12 S DIR("A")="List all reminders? "
13 S DIR("B")="Y"
14 W !
15 D ^DIR
16 I $D(DIROUT)!$D(DIRUT) Q
17 I $D(DTOUT)!$D(DUOUT) Q
18 S ALL=Y
19 S NCRIT=NCRIT+1
20 S CRITERIA(NCRIT)=DIR("A")_" "_Y(0)
21 I ALL G ACTIVEQ
22 ;
23LOCALQ K DIR,DIROUT,DIRUT,DTOUT,DUOUT
24 S DIR(0)="YAO"
25 S DIR("A")="List all local reminders? "
26 S DIR("B")="Y"
27 W !
28 D ^DIR
29 I $D(DTOUT) Q
30 I $D(DUOUT)!$D(DIROUT) G ALLQ
31 S LOCAL=Y
32 S NCRIT=NCRIT+1
33 S CRITERIA(NCRIT)=DIR("A")_" "_Y(0)
34 I LOCAL G ACTIVEQ
35 ;
36PREFIXQ K DIR,DIROUT,DIRUT,DTOUT,DUOUT
37 S PREFIX=""
38 S DIR(0)="FAO"_U_"1:30"
39 S DIR("A")="List only reminders starting with (prefix)? "
40 S DIR("B")="VA-"
41 W !
42 D ^DIR
43 I $D(DTOUT) Q
44 I $D(DUOUT)!$D(DIROUT) G LOCALQ
45 S PREFIX=Y
46 S LPREFIX=$L(Y)
47 S NCRIT=NCRIT+1
48 S CRITERIA(NCRIT)=DIR("A")_" "_PREFIX
49 ;
50ACTIVEQ K DIR,DIROUT,DIRUT,DTOUT,DUOUT
51 S DIR(0)="SAO"_U_"A:Active;I:Inactive;B:Both"
52 S DIR("A")="List Active (A), Inactive (I), Both (B)? "
53 S DIR("B")="B"
54 W !
55 D ^DIR
56 I $D(DTOUT) Q
57 I $D(DUOUT)!$D(DIROUT) G START
58 S STATUS=Y
59 S NCRIT=NCRIT+1
60 S CRITERIA(NCRIT)=DIR("A")_" "_Y(0)
61 ;
62SORTQ K DIR,DIROUT,DIRUT,DTOUT,DUOUT
63 S SORT="N"
64 S DIR(0)="SAO"_U_"N:Name (.01);P:Print name"
65 S DIR("A")="Sort list by Name (N), Print Name (P)? "
66 S DIR("B")="N"
67 W !
68 D ^DIR
69 I $D(DTOUT) Q
70 I $D(DUOUT)!$D(DIROUT) G ACTIVEQ
71 S SORT=Y_U_Y(0)
72 S NCRIT=NCRIT+1
73 S CRITERIA(NCRIT)=DIR("A")_" "_Y(0)
74 ;
75 ;Make sure the criteria are ok.
76 W !!,"A reminder list will be created using the following criteria:"
77 F IND=1:1:NCRIT D
78 . W !,?2,CRITERIA(IND)
79 ;
80 K CRITERIA
81 K DIR,DIROUT,DIRUT,DTOUT,DUOUT
82 S DIR(0)="YAO"
83 S DIR("A")="Is this correct? "
84 S DIR("B")="Y"
85 W !
86 D ^DIR
87 I $D(DTOUT) Q
88 I $D(DUOUT)!$D(DIROUT) G START
89 I 'Y G START
90 ;
91 ;Build the list of reminders based on the input critera.
92 N IEN,NAME,NODE0,SFUN
93 ;Setup the screening function to use
94 I ALL S SFUN="$$ALLS(NODE0,STATUS)"
95 I LOCAL S SFUN="$$LOCALS(NODE0,STATUS)"
96 I $L(PREFIX)>0 S SFUN="$$PREFIXS(NODE0,STATUS,PREFIX,LPREFIX)"
97 K ^TMP($J,"DEFLIST")
98 S IEN=0
99 F S IEN=$O(^PXD(811.9,IEN)) Q:+IEN=0 D
100 . S NODE0=^PXD(811.9,IEN,0)
101 . I @SFUN S ^TMP($J,"DEFLIST",IEN)=""
102 ;Print the list
103 N BY,DIC,FLDS,FR,L,PXRMFVPL,PXRMROOT,TO
104 D BLDRLIST^PXRMVPTR(811.902,.01,.PXRMFVPL)
105 S (DIC,PXRMROOT)="^PXD(811.9,"
106 S FLDS="[PXRM DEFINITION LIST]"
107 S L=0
108 S L(0)=1
109 I $P(SORT,U,1)="N" S BY=.01
110 I $P(SORT,U,1)="P" S BY=1.2
111 S BY(0)="^TMP($J,""DEFLIST"""
112 S (FR,TO)=""
113 D EN1^DIP
114 K ^TMP($J,"DEFLIST")
115 Q
116 ;
117 ;==================================================
118ALLS(NODE0,STATUS) ;Screen based on all reminders and status.
119 I STATUS="B" Q 1
120 N INFLAG
121 S INFLAG=$P(NODE0,U,6)
122 I (STATUS="A")&('INFLAG) Q 1
123 I (STATUS="I")&(INFLAG) Q 1
124 Q 0
125 ;
126 ;==================================================
127LOCALS(NODE0,STATUS) ;Screen based on all local reminders and status.
128 N NAME
129 S NAME=$P(NODE0,U,1)
130 I NAME["VA-" Q 0
131 I STATUS="B" Q 1
132 N INFLAG
133 S INFLAG=$P(NODE0,U,6)
134 I (STATUS="A")&('INFLAG) Q 1
135 I (STATUS="I")&(INFLAG) Q 1
136 Q 0
137 ;
138 ;==================================================
139PREFIXS(NODE0,STATUS,PREFIX,LPREFIX) ;Screen based on .01 prefix and status.
140 N NAME,PRE
141 S NAME=$P(NODE0,U,1)
142 S PRE=$E(NAME,1,LPREFIX)
143 I PRE'=PREFIX Q 0
144 I STATUS="B" Q 1
145 N INFLAG
146 S INFLAG=$P(NODE0,U,6)
147 I (STATUS="A")&('INFLAG) Q 1
148 I (STATUS="I")&(INFLAG) Q 1
149 Q 0
150 ;
Note: See TracBrowser for help on using the repository browser.