source: WorldVistAEHR/trunk/r/CLINICAL_REMINDERS-PXRM/PXRMLRM.m@ 619

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

initial load of WorldVistAEHR
File size: 5.0 KB
RevLine 
[613]1PXRMLRM ; SLC/PJH/PKR - List Rule Management ; 09/06/2007
2 ;;2.0;CLINICAL REMINDERS;**4,6**;Feb 04, 2005;Build 123
3 ;
4 ;Main entry point for PXRM LIST RULE MANAGEMENT
5START N PXRMDONE,PXRMTYP,VALMBCK,VALMCNT,VALMSG,X,XMZ,XQORM,XQORNOD
6 S X="IORESET"
7 D ENDR^%ZISS
8 S VALMCNT=0
9 ;Default view is Rule Sets
10 S PXRMTYP=3
11 D EN^VALM("PXRM LIST RULE MANAGEMENT")
12 Q
13 ;
14BLDLIST ;Build workfile
15 K ^TMP("PXRMLRM",$J)
16 N IEN,IND,PLIST
17 D LIST(.PLIST,.IEN,PXRMTYP)
18 M ^TMP("PXRMLRM",$J)=PLIST
19 S VALMCNT=PLIST("VALMCNT")
20 F IND=1:1:VALMCNT D
21 .S ^TMP("PXRMLRM",$J,"IDX",IND,IND)=IEN(IND)
22 I PXRMTYP=1 D CHGCAP^VALM("HEADER2","Finding Rule Name")
23 I PXRMTYP=2 D CHGCAP^VALM("HEADER2","Reminder Rule Name")
24 I PXRMTYP=3 D CHGCAP^VALM("HEADER2","Rule Set Name")
25 I PXRMTYP=4 D CHGCAP^VALM("HEADER2","Report Output Rule Name")
26 I PXRMTYP=5 D CHGCAP^VALM("HEADER2","Patient List Rule Name")
27 Q
28 ;
29ENTRY ;Entry code
30 D BLDLIST,XQORM
31 Q
32 ;
33EXIT ;Exit code
34 K ^TMP("PXRMLRM",$J)
35 K ^TMP("PXRMLRMH",$J)
36 D CLEAN^VALM10
37 D FULL^VALM1
38 S VALMBCK="Q"
39 Q
40 ;
41FRE(NUMBER,NAME,CLASS) ;Format entry number, name
42 ;and date packed.
43 N TCLASS,TEMP,TNAME,TSOURCE
44 S TEMP=$$RJ^XLFSTR(NUMBER,5," ")
45 S TNAME=$E(NAME,1,60)
46 S TEMP=TEMP_" "_$$LJ^XLFSTR(TNAME,60," ")
47 S TCLASS=$S(CLASS="N":"NATIONAL",CLASS="V":"VISN",1:"LOCAL")
48 S TEMP=TEMP_" "_TCLASS
49 Q TEMP
50 ;
51HDR ; Header code
52 S VALMSG="+ Next Screen - Prev Screen ?? More Actions"
53 Q
54 ;
55HELP(CALL) ;General help text routine
56 N HTEXT
57 I CALL=1 D
58 .S HTEXT(1)="Select DE to display or edit a rule.\\"
59 .S HTEXT(2)="Select ED to edit a rule.\\"
60 ;
61 I CALL=2 D
62 .S HTEXT(1)="Select F to edit term based finding rules.\\"
63 .S HTEXT(2)="Select P to edit patient list based finding rules.\\"
64 .S HTEXT(3)="Select R to edit reminder rules.\\"
65 .S HTEXT(4)="Select S to edit rule sets. A rule set may contain"
66 .S HTEXT(5)="any of the following:\\"
67 .S HTEXT(6)=" finding list rules, patient list rules, reminder rules\\"
68 .S HTEXT(7)="These component list rules must be created before the rule set"
69 .S HTEXT(8)="can be constructed."
70 ;
71 D HELP^PXRMEUT(.HTEXT)
72 Q
73 ;
74HLP ;Help code
75 N ORU,ORUPRMT,SUB,XQORM
76 S SUB="PXRMLRMH"
77 D EN^VALM("PXRM LIST RULE HELP")
78 Q
79 ;
80INIT ;Init
81 S VALMCNT=0
82 Q
83 ;
84LIST(RLIST,IEN,LRTYP) ;Build a list of list rule entries.
85 N DATA,IND,LRCLASS,LRNAME,NAME
86 ;Build the list in alphabetical order.
87 S VALMCNT=0
88 S NAME=""
89 F S NAME=$O(^PXRM(810.4,"B",NAME)) Q:NAME="" D
90 .S IND=$O(^PXRM(810.4,"B",NAME,"")) Q:'IND
91 .S DATA=$G(^PXRM(810.4,IND,0))
92 .I $P(DATA,U,3)'=LRTYP Q
93 .S LRNAME=$P(DATA,U)
94 .S LRCLASS=$P($G(^PXRM(810.4,IND,100)),U)
95 .S VALMCNT=VALMCNT+1
96 .S RLIST(VALMCNT,0)=$$FRE(VALMCNT,LRNAME,LRCLASS)
97 .S IEN(VALMCNT)=IND
98 S RLIST("VALMCNT")=VALMCNT
99 Q
100 ;
101LRADD ;Add Rule Option
102 ;
103 ;Reset Screen Mode
104 W IORESET
105 ;
106 ;Add Rule
107 D ADD^PXRMLRED
108 ;
109 ;Rebuild Workfile
110 D BLDLIST
111 S VALMBCK="R"
112 Q
113 ;
114LRINQ ;Rule Inquiry - PXRM LIST RULE DISPLAY/EDIT entry
115 N IND,LRIEN,VALMY
116 D EN^VALM2(XQORNOD(0))
117 ;If there is no list quit.
118 I '$D(VALMY) Q
119 S PXRMDONE=0
120 S IND=""
121 F S IND=$O(VALMY(IND)) Q:(+IND=0)!(PXRMDONE) D
122 .;Get the ien.
123 .S LRIEN=^TMP("PXRMLRM",$J,"IDX",IND,IND)
124 .D START^PXRMLRED(LRIEN,PXRMTYP)
125 D BLDLIST
126 S VALMBCK="R"
127 Q
128 ;
129PEXIT ;Protocol exit code
130 S VALMSG="+ Next Screen - Prev Screen ?? More Actions"
131 ;Reset after page up/down etc
132 D XQORM
133 Q
134 ;
135VIEW ;Select view
136 W IORESET
137 S VALMBCK="R"
138 N X,Y,CODE,DIR
139 K DIROUT,DIRUT,DTOUT,DUOUT
140 S DIR(0)="S"_U_"F:Finding Rule;"
141 S DIR(0)=DIR(0)_"P:Patient List Rule;"
142 S DIR(0)=DIR(0)_"R:Reminder Rule;"
143 S DIR(0)=DIR(0)_"S:Rule Set;"
144 S DIR("A")="TYPE OF VIEW"
145 S DIR("B")="F"
146 S DIR("?")="Select from the codes displayed. For detailed help type ??"
147 S DIR("??")=U_"D HELP^PXRMLRM(2)"
148 D ^DIR K DIR
149 I $D(DIROUT) S DTOUT=1
150 I $D(DTOUT)!($D(DUOUT)) Q
151 ;Change display type
152 S PXRMTYP=$S(Y="F":1,Y="P":5,Y="S":3,1:4)
153 S PXRMTYP=$S(Y="F":1,Y="P":5,Y="S":3,Y="R":2,1:4)
154 ;Rebuild Workfile
155 D BLDLIST,HDR
156 Q
157 ;
158XSEL ;PXRM LIST RULE MANAGEMENT SELECT ENTRY validation
159 N SEL,IEN
160 S SEL=$P(XQORNOD(0),"=",2)
161 ;Remove trailing ,
162 I $E(SEL,$L(SEL))="," S SEL=$E(SEL,1,$L(SEL)-1)
163 ;Invalid selection
164 I SEL["," D Q
165 .W $C(7),!,"Only one item number allowed." H 2
166 .S VALMBCK="R"
167 I ('SEL)!(SEL>VALMCNT)!('$D(@VALMAR@("IDX",SEL))) D Q
168 .W $C(7),!,SEL_" is not a valid item number." H 2
169 .S VALMBCK="R"
170 ;
171 ;Get the list ien.
172 S IEN=^TMP("PXRMLRM",$J,"IDX",SEL,SEL)
173 ;
174 ;Option to Display/Edit or Test Rule Set.
175 N DIR,OPTION,RIEN,X,Y
176 K DIROUT,DIRUT,DTOUT,DUOUT
177 S DIR(0)="SBM"_U_"DR:Display/Edit Rule;"
178 I $G(PXRMTYP)=3 S DIR(0)=DIR(0)_"TEST:Test Rule Set"
179 S DIR("A")="Select Action: "
180 S DIR("B")="DR"
181 S DIR("?")="Select from the codes displayed."
182 D ^DIR K DIR
183 I $D(DIROUT) S DTOUT=1
184 I $D(DTOUT)!($D(DUOUT)) S VALMBCK="R" Q
185 S OPTION=Y
186 I $G(OPTION)="" G XSELE
187 ;
188 ;Display/Edit
189 I OPTION="DR" D START^PXRMLRED(IEN,PXRMTYP)
190 Q:$D(DUOUT)!$D(DTOUT)
191 ;
192 ;Rule set test
193 I OPTION="TEST" D RSTEST^PXRMRST(IEN)
194 Q:$D(DUOUT)!$D(DTOUT)
195 ;
196XSELE ;
197 D CLEAN^VALM10
198 D BLDLIST,XQORM
199 S VALMBCK="R"
200 Q
201 ;
202XQORM S XQORM("#")=$O(^ORD(101,"B","PXRM LIST RULE MANAGEMENT SELECT ENTRY",0))_U_"1:"_VALMCNT
203 S XQORM("A")="Select Item: "
204 Q
205 ;
Note: See TracBrowser for help on using the repository browser.