source: WorldVistAEHR/trunk/r/CLINICAL_REMINDERS-PXRM/PXRMLRED.m@ 1006

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

initial load of WorldVistAEHR

File size: 6.5 KB
Line 
1PXRMLRED ; SLC/PJH - List Rule Editor ;05/30/2006
2 ;;2.0;CLINICAL REMINDERS;**4**;Feb 04, 2005;Build 21
3 ;
4 ;Main entry point for PXRM LIST RULE EDIT/DISPLAY
5START(IEN,PXRMTYP) ;
6 N PXRMDONE,VALMBCK,VALMCNT,VALMSG,X,XMZ,XQORM,XQORNOD
7 S X="IORESET"
8 D ENDR^%ZISS
9 S VALMCNT=0
10 D EN^VALM("PXRM LIST RULE DISPLAY/EDIT")
11 Q
12 ;
13ADD ;Add Rule
14 N DA,DIC,DONE,DTOUT,DUOUT,DLAYGO,HED,TYP,Y
15 S HED="ADD "_$$TXT,TYP=PXRMTYP,DONE=0
16 W IORESET,!
17 F D Q:$D(DTOUT) Q:DONE
18 .S DIC="^PXRM(810.4,"
19 .;Set the starting place for additions.
20 .D SETSTART^PXRMCOPY(DIC)
21 .S DIC(0)="AELMQ",DLAYGO=810.4
22 .S DIC("A")="Select "_$$TXT_" to add: "
23 .S DIC("DR")=".03///"_TYP
24 .D ^DIC
25 .I $D(DUOUT) S DTOUT=1
26 .I ($D(DTOUT))!($D(DUOUT)) Q
27 .I Y=-1 K DIC S DTOUT=1 Q
28 .I $P(Y,U,3)'=1 W !,"This rule name already exists" Q
29 .S DA=$P(Y,U,1)
30 .;Edit Rule
31 .D EDIT(DA,TYP)
32 .S:$D(DA) DONE=1
33 Q
34 ;
35BLDLIST(IEN,TYP) ;Build workfile
36 N FLDS,GBL,PXRMROOT
37 I TYP=1 S FLDS="[PXRM FINDING RULE]"
38 I TYP=2 S FLDS="[PXRM REMINDER RULE]"
39 I TYP=3 S FLDS="[PXRM RULE SET]"
40 I TYP=5 S FLDS="[PXRM PATIENT LIST RULE]"
41 S GBL="^TMP(""PXRMLRED"",$J)"
42 S GBL=$NA(@GBL)
43 S PXRMROOT="^PXRM(810.4,"
44 K ^TMP("PXRMLRED",$J)
45 D DIP^PXRMUTIL(GBL,IEN,PXRMROOT,FLDS)
46 S VALMCNT=$O(^TMP("PXRMLRED",$J,""),-1)
47 Q
48 ;
49EDIT(DA,TYP) ;Edit Rule
50 I '$$VEDIT^PXRMUTIL("^PXRM(810.4,",DA) D Q
51 .W !!,?5,"VA- and national class rules may not be edited" H 2
52 .S VALMBCK="R"
53 ;
54 Q:'$$LOCK(DA)
55 W IORESET
56 N CS1,CS2,DIC,DIDEL,DIE,DR,DTOUT,DUOUT,ODA,Y
57 ;Save checksum
58 S CS1=$$FILE^PXRMEXCS(810.4,DA)
59 ;Check rule type
60 S DIE="^PXRM(810.4,",DIDEL=810.4,ODA=DA
61 ;List Rule
62 I TYP=1 S DR="[PXRM EDIT FINDING RULE]"
63 ;Reminder Rule
64 I TYP=2 S DR="[PXRM EDIT REMINDER RULE]"
65 ;Rule Set
66 I TYP=3 S DR="[PXRM EDIT RULE SET]"
67 ;Report Output Rule
68 I TYP=4 S DR="[PXRM EDIT REPORT OUTPUT RULE]"
69 ;Patient List Rule
70 I TYP=5 S DR="[PXRM EDIT PATIENT LIST RULE]"
71 ;Display any sets using the rule
72 I (TYP'=3) D USE(DA,1)
73 ;
74 ;Save list of components for rule set
75 I TYP=3 N COMP D COMP^PXRMLREX(DA,.COMP)
76 ;
77 ;Edit rule then unlock
78 D ^DIE,UNLOCK(ODA)
79 ;Deleted ???
80 I '$D(DA) D Q
81 .;Option to delete components
82 .I TYP=3,$D(COMP) D DELETE^PXRMLREX(.COMP)
83 .S VALMBCK="Q"
84 ;
85 ;Update edit history
86 D
87 .S CS2=$$FILE^PXRMEXCS(810.4,DA) Q:CS2=CS1 Q:+CS2=0
88 .D SEHIST^PXRMUTIL(810.4,DIC,DA)
89 S VALMBCK="R"
90 Q
91 ;
92ENTRY ;Entry code
93 D BLDLIST(IEN,PXRMTYP)
94 Q
95 ;
96EXIT ;Exit code
97 K ^TMP("PXRMLRED",$J)
98 K ^TMP("PXRMLREDH",$J)
99 D CLEAN^VALM10
100 D FULL^VALM1
101 S VALMBCK="Q"
102 Q
103 ;
104HDR ; Header code
105 S VALMHDR(1)="Available "_$$LIT(PXRMTYP)_":"
106 S VALMSG="+ Next Screen - Prev Screen ?? More Actions"
107 Q
108 ;
109HLP ;Help code
110 N ORU,ORUPRMT,SUB,XQORM
111 S SUB="PXRMLREDH"
112 D EN^VALM("PXRM LIST RULE HELP")
113 Q
114 ;
115INIT ;Init
116 S VALMCNT=0
117 Q
118 ;
119LIT(VIEW) ;Header text depnds on view
120 Q $S(PXRMTYP=3:"Rule Sets",PXRMTYP=1:"List Rules",PXRMTYP=2:"Reminder List Rules",1:"Unknown")
121 ;
122LOCK(DA) ;Lock the record
123 L +^PXRM(810.4,DA):0 I Q 1
124 E W !!,?5,"Another user is editing this file, try later" H 2 Q 0
125 ;
126LRDESC ;Display list rule fields - called by [PXRM RULE SET]
127 N IEN
128 S IEN=$P(X,U,2) Q:'IEN
129 D LROUT(IEN,23)
130 Q
131 ;
132LREDIT ;Edit Rule
133 D EDIT^PXRMLRED(IEN,PXRMTYP)
134 ;Rebuild Workfile
135 D BLDLIST(IEN,PXRMTYP)
136 Q
137 ;
138LREND(END,RJC) ;Display end date
139 I END]"" W !,$$RJ^XLFSTR("LR Ending Date: ",RJC)_END
140 Q
141 ;
142LROUT(IEN,RJC) ;Output list rule display
143 ;also called for parameter display from PXRMEPM
144 N BEG,DATA,END,LRN,PLIST,PLIEN,TERM,TIEN,TYPE
145 S DATA=$G(^PXRM(810.4,IEN,0))
146 S LRN=$P(DATA,U,1)
147 ;Type of list rule, start and end dates
148 S TYPE=$P(DATA,U,3),BEG=$P(DATA,U,4),END=$P(DATA,U,5)
149 W !,$$RJ^XLFSTR("List Rule: ",RJC),LRN
150 ;Display description
151 W !,$$RJ^XLFSTR("Description: ",RJC),$P(DATA,U,2)
152 ;Display Rule Type
153 W !,$$RJ^XLFSTR("Rule Type: ",RJC)
154 ;Finding Rule
155 I TYPE=1 D
156 .W "FINDING RULE"
157 .W !,$$RJ^XLFSTR("Reminder Term: ",RJC+2)
158 .S TIEN=$P(DATA,U,7) Q:'TIEN
159 .;Display Term name
160 .W $P($G(^PXRMD(811.5,TIEN,0)),U)
161 I TYPE=2 D
162 .W "REMINDER RULE"
163 .W !,$$RJ^XLFSTR("Reminder Definition: ",RJC+2)
164 .S RIEN=$P(DATA,U,10) Q:'RIEN
165 .;Display Reminder Defintion name
166 .W $P($G(^PXD(811.9,RIEN,0)),U,1)
167 ;Patient List Rule
168 I TYPE=5 D
169 .W "PATIENT LIST RULE"
170 .N EXISTPL,EXTRPL
171 .S EXISTPL=$P(DATA,U,8)
172 .I EXISTPL]"" D
173 .. S EXISTPL=$P(^PXRMXP(810.5,EXISTPL,0),U,1)
174 .. W !,$$RJ^XLFSTR("Use Existing PT List: ",RJC+2),EXISTPL
175 .S EXTRPL=$G(^PXRM(810.4,IEN,1))
176 .I EXTRPL]"" W !,$$RJ^XLFSTR("Use Extract PT List Named: ",RJC+5)
177 .I (RJC+5+$L(EXTRPL))>80 W !," "
178 .W EXTRPL
179 ;Format Start and Stop Dates
180 D LRSTRT(BEG,RJC+2),LREND(END,RJC+2)
181 Q
182 ;
183LRSTRT(BEG,RJC) ;Display start date
184 I BEG]"" W !,$$RJ^XLFSTR("LR Beginning Date: ",RJC)_BEG
185 Q
186 ;
187PEXIT ;PXRM EXCH MENU protocol exit code
188 S VALMSG="+ Next Screen - Prev Screen ?? More Actions"
189 ;Reset after page up/down etc
190 Q
191 ;
192SCREEN ;validate rule type
193 Q:'$G(DA(1))
194 ;rule sets may not be a component of a rule set
195 I $P($G(^PXRM(810.4,DA(1),0)),U,3) S DIC("S")="I $P(^(0),U,3)'=3"
196 Q
197 ;
198SEQPRT ;Display list rule sequence fields - called by [PXRM RULE SET]
199 N EXTRPL,IND,LR,LRN,OPER,RJC,RR
200 N SEQ,SEQBDT,SEQEDT,TEMP,TEXT
201 S RJC=22
202 S SEQ=""
203 F S SEQ=$O(^PXRM(810.4,D0,30,"B",SEQ)) Q:SEQ="" D
204 . S IND=$O(^PXRM(810.4,D0,30,"B",SEQ,""))
205 . S TEMP=^PXRM(810.4,D0,30,IND,0)
206 . S LR=+$P(TEMP,U,2),OPER=$P(TEMP,U,3)
207 . S OPER=$$EXTERNAL^DILFD(810.41,.03,"",OPER)
208 . S TEMP=$G(^PXRM(810.4,D0,30,IND,1))
209 . S SEQBDT=$P(TEMP,U,1),SEQEDT=$P(TEMP,U,2)
210 . S EXTRPL=$G(^PXRM(810.4,D0,1))
211 . ;Output the sequence fields
212 . W !!,$$RJ^XLFSTR("Sequence: ",RJC),SEQ
213 . I SEQBDT]"" W !,$$RJ^XLFSTR("Seq Beginning Date: ",RJC),SEQBDT
214 . I SEQEDT]"" W !,$$RJ^XLFSTR("Seq Ending Date: ",RJC),SEQEDT
215 . W !,$$RJ^XLFSTR("Operation: ",RJC),OPER
216 .;Output the List Rule information
217 . D LROUT^PXRMLRED(LR,RJC)
218 Q
219 ;
220TXT() ;Return Rule Type text
221 N TEXT
222 S TEXT="OTHER"
223 I PXRMTYP=1 S TEXT="FINDING RULE"
224 I PXRMTYP=2 S TEXT="REMINDER DEFINITION RULE"
225 I PXRMTYP=3 S TEXT="RULE SET"
226 I PXRMTYP=5 S TEXT="PATIENT LIST RULE"
227 Q TEXT
228 ;
229UNLOCK(DA) ;Unlock the record
230 L -^PXRM(810.4,DA)
231 Q
232 ;
233USE(DA,EDIT) ;Display usage of list rule
234 N TTAB
235 S TAB=$S(EDIT:0,1:7)
236 W !!,?TAB,"Used by:"
237 ;If the AD cross ref is missing this is not used
238 I '$D(^PXRM(810.4,"AD",DA)) W " Not used by any rule set",! Q
239 ;
240 N LRNAM,LRTYP,PXRMTYP
241 S TAB=TAB+10
242 ;Check if used by any rule sets
243 S SUB=0
244 F S SUB=$O(^PXRM(810.4,"AD",DA,SUB)) Q:'SUB D
245 .S DATA=$G(^PXRM(810.4,SUB,0)) Q:DATA=""
246 .S LRNAM=$P(DATA,U) Q:LRNAM=""
247 .S PXRMTYP=$P(DATA,U,3),LRTYP=$$TXT^PXRMLRED
248 .W ?TAB,LRNAM_" ("_LRTYP_")",!
249 Q
250 ;
251USET ;Usage display called from PXRM LIST RULE print template
252 D USE(IEN,0)
253 Q
254 ;
Note: See TracBrowser for help on using the repository browser.