source: FOIAVistA/tag/r/CLINICAL_REMINDERS-PXRM/PXRMEXLD.m@ 636

Last change on this file since 636 was 636, checked in by George Lilly, 14 years ago

WorldVistAEHR overlayed on FOIAVistA
File size: 9.3 KB
Line 
1PXRMEXLD ;SLC/PJH - Reminder Dialog Exchange Main Routine. ;7/01/2004
2 ;;2.0;CLINICAL REMINDERS;**4**;Feb 04, 2005;Build 21
3 ;
4 ;=====================================================================
5START N PXRMBG,PXRMMODE,VALMBCK,VALMBG,VALMCNT,VALMSG,X,XMZ
6 S X="IORESET"
7 D EN^VALM("PXRM EX LIST DIALOG")
8 ;
9 ;Rebuild Display
10 D CDISP^PXRMEXLC(PXRMRIEN)
11 Q
12 ;
13ENTRY D FIND Q
14 ;
15DETAIL S PXRMMODE=0 D DISP(PXRMMODE) Q
16 ;
17 ;Display Findings
18 ;--------------------------
19FIND S PXRMMODE=2 D DISP(PXRMMODE) Q
20 ;
21 ;Display Dialog Summary
22 ;----------------------
23SUM S PXRMMODE=3 D DISP(PXRMMODE) Q
24 ;
25 ;Display Dialog Usage
26 ;--------------------
27USE S PXRMMODE=4 D DISP(PXRMMODE) Q
28 ;
29 ;Display Dialog Text
30 ;-------------------
31TEXT S PXRMMODE=1 D DISP(PXRMMODE) Q
32 ;
33EXIT K ^TMP("PXRMEXLD",$J) Q
34 ;
35PEXIT ;PXRM EXCH DIALOG MENU protocol exit code
36 S VALMSG="+ Next Screen - Prev Screen ?? More Actions"
37 ;Reset after page up/down etc
38 D XQORM
39 Q
40 ;
41HELP N ORU,ORUPRMT,XQORM,PXRMTAG S PXRMTAG="DLG"
42 D EN^VALM("PXRM EX DIALOG HELP")
43 Q
44 ;
45HDR S VALMHDR(1)="Packed reminder dialog: "
46 S VALMHDR(1)=VALMHDR(1)_$G(^TMP("PXRMEXTMP",$J,"PXRMDNAM"))
47 I $D(^TMP("PXRMEXTMP",$J,"PXRMDNAT")) D
48 .S VALMHDR(1)=VALMHDR(1)_" [NATIONAL DIALOG]"
49 S VALMHDR("TITLE")=VALMHDR(1)
50 S VALMSG="+ Next Screen - Prev Screen ?? More Actions"
51 Q
52 ;
53 ;Build list manager workfile from ^TMP("PXRMEXTMP" (see ^PXRMEXLB)
54DISP(VIEW) ;
55 N OLEV,ODSEQ
56 K ^TMP("PXRMEXLD",$J)
57 K PXRMEXRP
58 K ^TMP($J,"PXRMEXREP")
59 N DDATA,DDLG,DEND,DREP,DSTRT,IND,JND,NLINE,NSEL
60 S NLINE=0,NSEL=0,VALMBCK="R",VALMCNT=NLINE
61 S DDLG=$G(^TMP("PXRMEXTMP",$J,"PXRMDNAM")) Q:DDLG=""
62 ;
63 ;Save reminder dialog
64 S DDATA=^TMP("PXRMEXTMP",$J,"DLOC",DDLG)
65 S DSTRT=$P(DDATA,U,1),DEND=$P(DDATA,U,2)
66 S IND=$P(DDATA,U,3),JND=$P(DDATA,U,4),DREP=""
67 D DLINE(DDLG,"","")
68 S NLINE=NLINE+1,^TMP("PXRMEXLD",$J,NLINE,0)=$J("",79)
69 S ^TMP("PXRMEXLD",$J,"IDX",NLINE,NSEL)=""
70 ;Process componentS
71 D DCMP(DDLG,"")
72 ;Process replacement elements
73 ;I $D(^TMP("PXRMEXTMP",$J,"DREPL"))>0 D DREPL^PXRMEXLC
74 I $D(PXRMEXRP)>0 D DREPL^PXRMEXLC
75 ;Change header
76 I VIEW=0 D CHGCAP^VALM("HEADER2","Dialog Details")
77 I VIEW=1 D CHGCAP^VALM("HEADER2","Dialog Text")
78 I VIEW=2 D CHGCAP^VALM("HEADER2","Dialog Findings")
79 I VIEW=3 D CHGCAP^VALM("HEADER2","Dialog Summary")
80 I VIEW=4 D CHGCAP^VALM("HEADER2","Dialog Usage")
81 ;
82 S VALMCNT=NLINE,^TMP("PXRMEXLD",$J,"VALMCNT")=VALMCNT,VALMBG=1
83 ;
84 K ^TMP($J,"PXRMEXREP"),PXRMEXRP
85 ;Reset protocol
86 D XQORM
87 Q
88 ;
89 ;Update workfile
90DLINE(DNAM,LEV,DSEQ) ;
91 ;Check if standard PXRM prompt
92 N LEVSEQ,TLEV
93 N DPXRM S DPXRM=$$PXRM^PXRMEXID(DNAM)
94 ;
95 ;Ignore PXRM prompts if doing a finding view (DF)
96 I VIEW>1,DPXRM Q
97 ;
98 N DEXIST,DPTX,DTXT,DTYP,EXIST,ITEM,TEMP,SEP
99 S ITEM=""
100 I DPXRM=0 S NSEL=NSEL+1,ITEM=NSEL
101 S NLINE=NLINE+1,SEP=$E(LEV,$L(LEV)),DEXIST=0
102 S LEVSEQ=LEV_DSEQ
103 S TEMP=$J(ITEM,3)_$J("",4)_LEV_DSEQ
104 ;Determine type
105 S DTYP=$G(^TMP("PXRMEXTMP",$J,"DTYP",DNAM))
106 ;Dialog component display
107 I (VIEW'=1) D
108 .I $L(TEMP)<13 S TEMP=TEMP_$J("",12+$L(SEP)-$L(TEMP))_$E(DNAM,1,50)
109 .E S TEMP=TEMP_" "_$E(DNAM,1,50)
110 I VIEW=1 D
111 .I DTYP]"" S DTXT=$G(^TMP("PXRMEXTMP",$J,"DTXT",DNAM))
112 .I DTYP="" S DTXT=DNAM
113 .I DREP'="" S DTXT=DNAM
114 .I $L(TEMP)<13 S TEMP=TEMP_$J("",12+$L(SEP)-$L(TEMP))_$E(DTXT,1,50)
115 .E S TEMP=TEMP_" "_$E(DTXT,1,50)
116 ;Check for replacements
117 I $D(^TMP("PXRMEXTMP",$J,"DREPL",DNAM))>0 D
118 .S TEMP=TEMP_"*"
119 .S TLEV=$S($E(LEVSEQ,$L(LEVSEQ))=".":$E(LEVSEQ,1,$L(LEVSEQ)-1),1:LEVSEQ)
120 .S PXRMEXRP(DNAM)=""
121 .;S ^TMP($J,"PXRMEXREP",TLEV,DNAM)=""
122 ;Add Type
123 S TEMP=TEMP_$J("",65-$L(TEMP))_DTYP
124 ;Exists flag
125 I DPXRM=0,$$EXISTS^PXRMEXIU(801.41,DNAM) D
126 .S TEMP=TEMP_$J("",75-$L(TEMP))_"X",DEXIST=1
127 S ^TMP("PXRMEXLD",$J,NLINE,0)=TEMP
128 ;
129 ;Set up selection index
130 S ^TMP("PXRMEXLD",$J,"IDX",NLINE,NSEL)="" Q:DPXRM=1
131 ;Store the file number, start and stop line in the exchange file.
132 S ^TMP("PXRMEXLD",$J,"SEL",NSEL)=FILENUM_U_DSTRT_U_DEND_U_DEXIST_U_IND_U_JND
133 ;Insert additional text lines
134 I VIEW=1,DREP="" D
135 .N DSUB,DTXT,FILENUM
136 .S DSUB=0,FILENUM=8927.1
137 .F S DSUB=$O(^TMP("PXRMEXTMP",$J,"DTXT",DNAM,DSUB)) Q:'DSUB D
138 ..S DTXT=$G(^TMP("PXRMEXTMP",$J,"DTXT",DNAM,DSUB)),NLINE=NLINE+1
139 ..S ^TMP("PXRMEXLD",$J,NLINE,0)=$J("",12+$L(SEP))_$E(DTXT,1,50)
140 ..S ^TMP("PXRMEXLD",$J,"IDX",NLINE,NSEL)=""
141 .;TIU template changes
142 .I $D(PXRMNMCH(FILENUM)),$D(^TMP("PXRMEXTMP",$J,"DTIU",DNAM)) D
143 ..N TEMP,TNAM,TNNAM
144 ..S TNAM=""
145 ..F S TNAM=$O(^TMP("PXRMEXTMP",$J,"DTIU",DNAM,TNAM)) Q:TNAM="" D
146 ...S TNNAM=$G(PXRMNMCH(FILENUM,TNAM)) Q:TNNAM=""
147 ...S NLINE=NLINE+1,^TMP("PXRMEXLD",$J,NLINE,0)=$J("",79)
148 ...S ^TMP("PXRMEXLD",$J,"IDX",NLINE,NSEL)=""
149 ...S TEMP=$J("",12+$L(SEP))_"(TIU template "_TNAM_" copied to "_TNNAM_")"
150 ...S NLINE=NLINE+1,^TMP("PXRMEXLD",$J,NLINE,0)=TEMP
151 ...S ^TMP("PXRMEXLD",$J,"IDX",NLINE,NSEL)=""
152 ...S NLINE=NLINE+1,^TMP("PXRMEXLD",$J,NLINE,0)=$J("",79)
153 ...S ^TMP("PXRMEXLD",$J,"IDX",NLINE,NSEL)=""
154 ;Insert finding items
155 I VIEW=2,("element;group"[DTYP),DREP="" D
156 .N DSUB,FDATA,FILENUM,FLIT,FLONG,FNAME,FOUND,FREP,FTAB,FTYP,TEMP
157 .;Findings and additional findings
158 .S DSUB=0,FOUND=0
159 .F S DSUB=$O(^TMP("PXRMEXTMP",$J,"DFND",DNAM,DSUB)) Q:'DSUB D
160 ..S FNAME=$G(^TMP("PXRMEXTMP",$J,"DFND",DNAM,DSUB)) Q:FNAME=""
161 ..S FDATA=$G(^TMP("PXRMEXFND",$J,FNAME))
162 ..S FILENUM=$P(FDATA,U),FTYP=$P(FDATA,U,2) Q:'FILENUM
163 ..S FREP=$G(PXRMNMCH(FILENUM,FNAME)) I FREP=FNAME S FREP=""
164 ..S NLINE=NLINE+1,EXIST=$$EXISTS^PXRMEXIU(FILENUM,FNAME),FOUND=1
165 ..I DSUB=1 S FLIT="Finding: "
166 ..I DSUB>1 S FLIT="Add. Finding: "
167 ..S FLONG=0 I $L(FLIT_FNAME_" ("_FTYP_")")>60 S FLONG=1
168 ..I 'FLONG S FNAME=FLIT_FNAME_" ("_FTYP_")"
169 ..I FLONG S FNAME=FLIT_FNAME
170 ..S TEMP=$J("",12+$L(SEP))_$E(FNAME,1,60)_$J("",60-$L(FNAME))
171 ..I EXIST S TEMP=TEMP_$J("",75-$L(TEMP))_"X"
172 ..S ^TMP("PXRMEXLD",$J,NLINE,0)=TEMP
173 ..S ^TMP("PXRMEXLD",$J,"IDX",NLINE,NSEL)=""
174 ..I FLONG D
175 ...S NLINE=NLINE+1
176 ...S FTAB=$S(DSUB=1:21,1:26)
177 ...S ^TMP("PXRMEXLD",$J,NLINE,0)=$J("",FTAB)_"("_FTYP_")"
178 ...S ^TMP("PXRMEXLD",$J,"IDX",NLINE,NSEL)=""
179 ..I FREP'="" D
180 ...S NLINE=NLINE+1
181 ...S FTAB=$S(DSUB=1:21,1:26)
182 ...S ^TMP("PXRMEXLD",$J,NLINE,0)=$J("",FTAB)_"(Replaced by "_FREP_")"
183 ...S ^TMP("PXRMEXLD",$J,"IDX",NLINE,NSEL)=""
184 .;If no findings
185 .I 'FOUND D
186 ..S NLINE=NLINE+1
187 ..S ^TMP("PXRMEXLD",$J,NLINE,0)=$J("",12+$L(SEP))_"Finding: *NONE*"
188 ..S ^TMP("PXRMEXLD",$J,"IDX",NLINE,NSEL)=""
189 ;
190 ;Usage screen
191 I VIEW=4,DREP="" D
192 .N DOTHER,DTXT,DTYPE,OTHER,TYPE
193 .D OTHER(DNAM,.DOTHER) Q:'$D(DOTHER)
194 .S OTHER=""
195 .F S OTHER=$O(DOTHER(OTHER)) Q:OTHER="" D
196 ..S TYPE=DOTHER(OTHER),NLINE=NLINE+1,DTYPE="REMINDER DIALOG"
197 ..I TYPE="G" S DTYPE="DIALOG GROUP"
198 ..I TYPE="E" S DTYPE="DIALOG ELEMENT"
199 ..S DTXT="USED BY: "_OTHER_" ("_DTYPE_")"
200 ..S ^TMP("PXRMEXLD",$J,NLINE,0)=$J("",12+$L(SEP))_DTXT
201 ..S ^TMP("PXRMEXLD",$J,"IDX",NLINE,NSEL)=""
202 Q
203 ;
204 ;Save details of dialog components for display
205DCMP(DLG,LEV) ;
206 N DDATA,DDLG,DEND,DNAM,DSEQ,DSTRT,IND,JND,LAST,LEVSEQ,NUM
207 S DSEQ=0,LAST=0
208 F S DSEQ=$O(^TMP("PXRMEXTMP",$J,"DMAP",DLG,DSEQ)) Q:'DSEQ D
209 .S DDATA=^TMP("PXRMEXTMP",$J,"DMAP",DLG,DSEQ)
210 .S DNAM=$P(DDATA,U),DSTRT=$P(DDATA,U,2),DEND=$P(DDATA,U,3) Q:DNAM=""
211 .S IND=$P(DDATA,U,4),JND=$P(DDATA,U,5)
212 .;Check if this component has been replaced
213 .S DREP=$G(PXRMNMCH(FILENUM,DNAM)) I DREP=DNAM S DREP=""
214 .;Save line in workfile
215 .S NUM=DSEQ
216 .;S NUM=$S($G(REPL)["R":"."_DSEQ,1:DSEQ)
217 .I +LEV>0,NUM>0,$E(LEV,$L(LEV))'="." S LEV=LEV_"."
218 .D DLINE(DNAM,LEV,NUM) Q:DREP'=""
219 .I $D(^TMP("PXRMEXTMP",$J,"DMAP",DNAM)) D DCMP(DNAM,LEV_DSEQ_".")
220 .;Extra line feed
221 .I LEV="" D
222 ..S NLINE=NLINE+1,^TMP("PXRMEXLD",$J,NLINE,0)=$J("",79)
223 ..S ^TMP("PXRMEXLD",$J,"IDX",NLINE,NSEL)=""
224 I $G(REPL)["R" D
225 .S NLINE=NLINE+1,^TMP("PXRMEXLD",$J,NLINE,0)=$J("",79)
226 .S ^TMP("PXRMEXLD",$J,"IDX",NLINE,NSEL)=""
227 Q
228 ;
229 ;Rebuild string in ascending or descending order
230ORDER(STRING,ORDER) ;
231 N ARRAY,ITEM,CNT
232 F CNT=1:1 S ITEM=$P(STRING,",",CNT) Q:'ITEM S ARRAY(ITEM)=""
233 K STRING
234 F CNT=1:1 S ITEM=$O(ARRAY(ITEM),ORDER) Q:'ITEM D
235 .S $P(STRING,",",CNT)=ITEM
236 Q
237 ;
238 ;Check if used by other dialogs
239OTHER(NAME,LIST) ;
240 N DDATA,DIEN,DNAME,DTYP,IEN
241 S IEN=$O(^PXRMD(801.41,"B",NAME,0)) Q:'IEN
242 ;Check if used by other dialogs
243 I '$D(^PXRMD(801.41,"AD",IEN)) Q
244 ;Build list of dialogs using this component
245 S DIEN=0
246 F S DIEN=$O(^PXRMD(801.41,"AD",IEN,DIEN)) Q:'DIEN D
247 .S DDATA=$G(^PXRMD(801.41,DIEN,0)) Q:DDATA=""
248 .S DNAME=$P(DDATA,U),DTYP=$P(DDATA,U,4) Q:DNAME=""
249 .;Include only dialogs that are not part of this reminder dialog
250 .I $D(^TMP("PXRMEXTMP",$J,"DMAP",DNAME)) Q
251 .S LIST(DNAME)=DTYP
252 Q
253 ;
254 ;Validate sequence numbers
255VALID(STRING) ;
256 N CNT,FOUND,OK
257 S FOUND=0,OK=1
258 F CNT=1:1 S SEL=$P(STRING,",",CNT) Q:'SEL D
259 .;Invalid selection
260 .I ('SEL)!(SEL>VALMCNT)!('$D(@VALMAR@("SEL",SEL))) D Q
261 ..S OK=0 W $C(7),!,SEL_" is not a valid item number." H 2
262 .S FOUND=1
263 Q:OK&FOUND 1
264 Q 0
265 ;
266XQORM S XQORM("#")=$O(^ORD(101,"B","PXRM EXCH SELECT DIALOG",0))_U_"1:"_VALMCNT
267 S XQORM("A")="Select Action: "
268 Q
269 ;
270XSEL ;PXRM EXCH SELECT DIALOG validation
271 N ALL,CNT,ERR,IEN,IND,PXRMDONE,SELECT,SEL
272 S ALL="",PXRMDONE=0,PXRMBG=$G(VALMBG)
273 ;Invalid selection
274 S SELECT=$P(XQORNOD(0),"=",2) I '$$VALID(SELECT) S VALMBCK="R" Q
275 ;
276 ;Sort the SELECTION into reverse order
277 D ORDER(.SELECT,-1)
278 ;
279 ;Lock the file
280 I '$$LOCK^PXRMEXID S VALMBCK="R" Q
281 ;
282 ;Install dialog component(s)
283 S CNT=0
284 F CNT=1:1 S SEL=$P(SELECT,",",CNT) Q:'SEL D Q:PXRMDONE
285 .D INSCOM^PXRMEXID(SEL,0)
286 ;
287 ;Unlock file
288 D UNLOCK^PXRMEXID
289 ;
290 ;
291 ;Rebuild Workfile
292 D DISP^PXRMEXLD(PXRMMODE)
293 ;
294 ;Refresh
295 S VALMBCK="R" I $D(PXRMBG) S VALMBG=PXRMBG
296 Q
Note: See TracBrowser for help on using the repository browser.