source: FOIAVistA/trunk/r/CLINICAL_REMINDERS-PXRM/PXRMDLG4.m@ 1801

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

initial load of FOIAVistA 6/30/08 version
File size: 9.5 KB
Line 
1PXRMDLG4 ; SLC/PJH - Reminder Dialog Edit/Inquiry ;06/05/2007
2 ;;2.0;CLINICAL REMINDERS;**4,6**;Feb 04, 2005;Build 123
3 ;
4WP(SUB,SUB1,WIDTH,SEQ,VALMCNT) ;Format WP text
5 N DIWF,DIWL,DIWR,IC,TEXT,X,TXTCNT,DTXT,CNT,SUB2
6 S (CNT,SUB2,TXTCNT)=0
7 F S SUB2=$O(^PXRMD(801.41,SUB,SUB1,SUB2)) Q:'SUB2 D
8 .S TXTCNT=TXTCNT+1,DTXT(TXTCNT)=$G(^PXRMD(801.41,SUB,SUB1,SUB2,0))
9 .S DTXT(TXTCNT)=$$STRREP^PXRMUTIL($G(DTXT(TXTCNT)),"<br>","\\")
10 I TXTCNT>0 D
11 .N OUTPUT,NLINES
12 .S NLINES=0 D FORMAT^PXRMTEXT(1,WIDTH,TXTCNT,.DTXT,.NLINES,.OUTPUT)
13 .I NLINES>0 K DTXT M DTXT=OUTPUT
14 S CNT=0
15 F S CNT=$O(DTXT(CNT)) Q:CNT="" D
16 .S TEXT=$G(DTXT(CNT)),VALMCNT=VALMCNT+1
17 .S ^TMP(NODE,$J,VALMCNT,0)=SEQ_TEXT,SEQ=$J("",$L(SEQ))
18 Q
19 ;
20ADD ;PXRM DIALOG ADD ELEMENT validation
21 N ANS,DTOUT,DUOUT,LIT,LOCK,Y,PIEN,ERR,IEN,NATIONAL,SEQ
22 W IORESET
23 S VALMBCK="R",NATIONAL=0
24 I $P($G(^PXRMD(801.41,PXRMDIEN,100)),U)="N" S NATIONAL=1
25 S LOCK=$P($G(^PXRMD(801.41,PXRMDIEN,100)),U,4)
26 I NATIONAL,'($G(PXRMINST)=1)&(DUZ(0)="@"),$G(LOCK)'=1 D Q
27 .W !,"Elements may not be added to national reminder dialogs" H 2
28 ;
29 F D SEQ(.SEQ,.PIEN) Q:$D(DUOUT)!$D(DTOUT) Q:SEQ
30 Q:$D(DUOUT)!$D(DTOUT)
31 ;
32 ;Check if sequence number is OK
33 I $G(PIEN)="" Q
34 S ANS="N" D ASK^PXRMDLG5(.ANS,PIEN) Q:$D(DUOUT)!$D(DTOUT)!($G(ANS)="N")
35 ;
36 ;Select a dialog element to add to parent dialog (PIEN)
37 ;PIEN may be dialog or a group within the dialog
38 D ESEL^PXRMDEDT(PIEN,SEQ)
39 ;Rebuild workfile
40 D BUILD^PXRMDLG(VIEW)
41 Q
42 ;
43FADD(DIEN,FTAB) ;Additional Findings
44 N FIND,FSUB,FTYP,FNAME,FNUM
45 S FSUB=0
46 F S FSUB=$O(^PXRMD(801.41,DIEN,3,FSUB)) Q:'FSUB D
47 .S FIND=$P($G(^PXRMD(801.41,DIEN,3,FSUB,0)),U) Q:FIND=""
48 .S FNAME="" D FDESC(FIND) Q:FNAME=""
49 .;Save additional finding name
50 .S FOUND=1 D FSAVE(2,FNAME,FTYP,FTAB,FIND)
51 Q
52 ;
53DETAIL(DIEN,LEV,VIEW,NODE) ;;Build listman global for all components
54 N DDATA,DDLG,DEND,DCIEN,DNAM,DSEQ,DSTRT,IND,JND,DSUB
55 S DSEQ=0
56 ;
57 ;Get each sequence number
58 F S DSEQ=$O(^PXRMD(801.41,DIEN,10,"B",DSEQ)) Q:'DSEQ D
59 .;Determine subscript
60 .S DSUB=$O(^PXRMD(801.41,DIEN,10,"B",DSEQ,"")) Q:'DSUB
61 .;Get ien of prompt/component
62 .S DCIEN=$P($G(^PXRMD(801.41,DIEN,10,DSUB,0)),U,2) Q:'DCIEN
63 .I "PF"[$P($G(^PXRMD(801.41,DCIEN,0)),U,4) Q
64 .;Save line in workfile
65 .D DLINE(DCIEN,LEV,DSEQ,NODE)
66 .;Build pointers back to parent
67 .I VIEW'=4 D
68 ..S ^TMP("PXRMDLG4",$J,"IEN",NSEL)=DIEN_U_DSEQ
69 ..S ^TMP("PXRMDLG4",$J,"SEQ",LEV_DSEQ)=DCIEN
70 .;Process any sub-components
71 .I VIEW<5 D DETAIL(DCIEN,LEV_DSEQ_".",VIEW,NODE)
72 Q
73 ;
74DLINE(DIEN,LEV,DSEQ,NODE) ;Save individual component details
75 N CNT,DBOX,DCAP,DDIS,DMULT,DSUPP,DSHOW,DTYP,DTXT
76 N IC,RESNM,RESULT,RIEN,RNAME,RCNT
77 ;Dialog name
78 S DDATA=$G(^PXRMD(801.41,DIEN,0)),DNAM=$P(DDATA,U) Q:DNAM=""
79 ;Check if standard PXRM prompt
80 I $$PXRM^PXRMEXID(DNAM) Q
81 ;Dialog Type and Disabled
82 S DDIS=$P(DDATA,U,3),DTYP=$P(DDATA,U,4)
83 S DTYP=$S(DTYP="G":"Group",1:"Element"),DNAM=DTYP_": "_DNAM
84 I VIEW=5 S DNAM=DNAM
85 ;Resolution type and name
86 S RNAME="",RIEN=$P($G(^PXRMD(801.41,DIEN,1)),U,3)
87 I RIEN S RNAME=$P($G(^PXRMD(801.9,RIEN,0)),U)
88 ;
89 ;Group fields
90 I DTYP="Group" D
91 .S DGRP=1,DTXT=$P(DDATA,U,5),DCAP=" [group caption]"
92 .I DTXT="" S DCAP=""
93 .I DTXT]"" S DCAP=DTXT_" "_DCAP
94 .S DBOX=$S($P(DDATA,U,6)="Y":"BOX",1:"NO BOX")
95 .S DSUPP=$S($P(DDATA,U,11):"SUPPRESS",1:"NO SUPPRESS")
96 .S DSHOW=$S($P(DDATA,U,10):"HIDE",1:"SHOW")
97 .S DMULT=$P(DDATA,U,9)
98 .S DMULT=$S(DMULT=1:"ONE ONLY",DMULT=2:"ONE OR MORE",DMULT=3:"NONE OR ONE",1:"NO SELECTION")
99 ;
100 N DPTX,DTXT,EXIST,ITEM,TEMP,SEP,SEQ,TAB,ALTLEN
101 S NSEL=NSEL+1,NLINE=NLINE+1,ITEM=NSEL,SEP=$E(LEV,$L(LEV)),SEQ=LEV_DSEQ
102 ;Suppress Item numbers for INQ options
103 I VIEW=4 S ITEM=""
104 ;Otherwise display Item, Sequence and Dialog Name
105 S TEMP=$J(ITEM,4)_$J("",3)_SEQ,TAB=$L(TEMP)+2
106 S CNT=0 F IC=1:1 Q:'$P(SEQ,".",IC) S:$P(SEQ,".",IC)<10 CNT=CNT+1
107 S TAB=TAB+CNT
108 ;
109 S ALTLEN=$L(TEMP)
110 ;Display dialog name
111 S TEMP=TEMP_$J("",2+CNT)_DNAM
112 ;Add disabled if present
113 I DDIS]"" S TEMP=TEMP_" (Disabled)"
114 ;
115 S ^TMP(NODE,$J,NLINE,0)=TEMP
116 ;check for alternate dialog element/group
117 I VIEW<2!(VIEW>4) D
118 .I $D(^PXRMD(801.41,DIEN,49))>0 D ALT^PXRMDLG5(DIEN,LEV,DSEQ,NODE,VIEW,.NLINE,CNT,ALTLEN)
119 ;
120 ;Dialog Text or P/N Text
121 I (VIEW=2)!(VIEW=3)!(VIEW=4) D
122 .N DGBEG,DGSUB,TSUB
123 .S DGSUB=0,TSUB=$$TSUB^PXRMDLG1(DIEN,VIEW)
124 .I VIEW=4 S DGBEG=$J("",TAB)_"Text: "
125 .I VIEW'=4 S DGBEG=$J("",5+$L(SEQ)+CNT+$L(DTYP))_"Text: "
126 .D WP(DIEN,TSUB,65,.DGBEG,.NLINE)
127 .I DTYP="Group" D
128 ..S TEMP=DGBEG_"["_DBOX_", "_DSUPP_", "_DSHOW_", "_DMULT_"]"
129 ..S NLINE=NLINE+1,^TMP(NODE,$J,NLINE,0)=TEMP
130 ;
131 ;Set up selection index
132 S ^TMP(NODE,$J,"IDX",NSEL,DIEN)=""
133 ;Insert finding items
134 I (VIEW=1)!(VIEW=4),("Element;Group"[DTYP) D
135 .N DSUB,FDATA,FILENUM,FLIT,FLONG,FNAME,FOUND,FREP,FTYP,TEMP
136 .;Findings
137 .S FNAME="",FOUND=0
138 .D FDESC($P($G(^PXRMD(801.41,DIEN,1)),U,5))
139 .I FNAME'="" S FOUND=1 D FSAVE(1,FNAME,FTYP,TAB)
140 .;Resolution
141 .I RNAME]"" D
142 ..S TEMP=$J("",TAB)_"Resolution: "_RNAME
143 ..S NLINE=NLINE+1,^TMP(NODE,$J,NLINE,0)=TEMP
144 .;Result Group
145 .I VIEW=4 D
146 ..S RCNT=0 F S RCNT=$O(^PXRMD(801.41,DIEN,51,RCNT)) Q:RCNT'>0 D
147 ...S RESULT=$P($G(^PXRMD(801.41,DIEN,51,RCNT,0)),U)
148 ...S RESNM=$P($G(^PXRMD(801.41,RESULT,0)),U) Q:RESNM=""
149 ...S TEMP=$J("",TAB)_"Result Group: "_RESNM
150 ...S NLINE=NLINE+1,^TMP(NODE,$J,NLINE,0)=TEMP
151 .;Additional findings
152 .D FADD(DIEN,TAB)
153 ;Get additional prompts
154 I VIEW=2 D
155 .S FIEN=$P($G(^PXRMD(801.41,DIEN,1)),U,5)
156 .I $G(FIEN)["PXD(811.2," D TAX^PXRMDLG1(FIEN,DSEQ,DIEN,.NLINE,NODE)
157 .I $G(FIEN)["ICPT"!($G(FIEN)["ICD9") D FIND^PXRMDLG1(FIEN,DSEQ,DIEN,.NLINE,NODE)
158 .D FADD(DIEN,TAB)
159 I VIEW,VIEW<5,"Element;Group"[DTYP D PROMPT(DIEN,TAB,"Prompts: ",VIEW)
160 ;
161 I VIEW=4,$D(^PXRMD(801.41,DIEN,49))>0 D ALT^PXRMDLG5(DIEN,LEV,DSEQ,NODE,VIEW,.NLINE,CNT,ALTLEN)
162 S NLINE=NLINE+1
163 S ^TMP(NODE,$J,NLINE,0)=$J("",79)
164 Q
165 ;
166FDESC(FIEN) ;Finding description
167 N FGLOB,FITEM,FNUM
168 S FGLOB=$P(FIEN,";",2) Q:FGLOB=""
169 S FITEM=$P(FIEN,";") Q:FITEM=""
170 S FNUM=" ["_FITEM_"]"
171 I FGLOB["ICD9" D Q
172 .S FTYP="DIAGNOSIS",FGLOB=U_FGLOB_FITEM_",0)"
173 .S FNAME=$P($G(@FGLOB),U,3)_FNUM
174 I FGLOB["WV" D Q
175 .S FTYP="WH NOTIFICATION PURPOSE",FGLOB=U_FGLOB_FITEM_",0)"
176 .S FNAME=$P($G(@FGLOB),U)_FNUM
177 I FGLOB["ICPT" D Q
178 .S FTYP="PROCEDURE",FGLOB=U_FGLOB_FITEM_",0)"
179 .S FNAME=$P($G(@FGLOB),U,2)_FNUM
180 I FGLOB["ORD(101.41" D Q
181 .S FTYP="QUICK ORDER",FGLOB=U_FGLOB_FITEM_",0)"
182 .S FNAME=$P($G(@FGLOB),U,2)_FNUM
183 ;Short name for finding type
184 S FTYP=$G(DEF1(FGLOB)) Q:FTYP=""
185 ;Long name
186 S FTYP=$G(DEF2(FTYP))
187 S FGLOB=U_FGLOB_FITEM_",0)"
188 S FNAME=$P($G(@FGLOB),U,1)_FNUM
189 I FNAME="" S FNAME=$P($G(@FGLOB),U)_FNUM
190 I FNAME="" S FNAME=FITEM
191 Q
192 ;
193FSAVE(DSUB,FNAME,FTYP,FTAB,FIEN) ;Save finding details
194 N TEMP
195 I DSUB=1 S FLIT="Finding: "
196 I DSUB>1 S FLIT="Add. Finding: "
197 S FLONG=0
198 ;change code to use IOM instead of default length of 60
199 I $L(FLIT_FNAME_" ("_FTYP_")")>(IOM-20) S FLONG=1
200 I 'FLONG S FNAME=FLIT_FNAME_" ("_FTYP_")"
201 I FLONG S FNAME=FLIT_FNAME
202 S TEMP=$J("",FTAB)_$E(FNAME,1,(IOM-20))_$J("",60-$L(FNAME))
203 S NLINE=NLINE+1
204 S ^TMP(NODE,$J,NLINE,0)=TEMP
205 I FLONG S NLINE=NLINE+1,^TMP(NODE,$J,NLINE,0)=$J("",FTAB)_"("_FTYP_")"
206 I VIEW=2 D
207 .I $G(FIEN)["ICPT"!($G(FIEN)["ICD9") D FIND^PXRMDLG1(FIEN,DSEQ,DIEN,.NLINE,NODE)
208 Q
209 ;
210PROMPT(IEN,TAB,TEXT,VIEW) ;additional prompts in the dialog file
211 N DATA,DDIS,DGSEQ,DSUB,DTITLE,DTXT,DTYP,SEQ,SUB
212 S SEQ=0
213 F S SEQ=$O(^PXRMD(801.41,IEN,10,"B",SEQ)) Q:'SEQ D
214 .S SUB=$O(^PXRMD(801.41,IEN,10,"B",SEQ,"")) Q:'SUB
215 .S DSUB=$P($G(^PXRMD(801.41,IEN,10,SUB,0)),U,2) Q:'DSUB
216 .S DATA=$G(^PXRMD(801.41,DSUB,0)) Q:DATA=""
217 .S DNAME=$P(DATA,U),DDIS=$P(DATA,U,3),DTYP=$P(DATA,U,4)
218 .I "PF"'[DTYP Q
219 .I DTYP="F" S DNAME=DNAME_" (forced value)"
220 .I DTYP="P",(VIEW=2)!(VIEW=3) D
221 ..;Override prompt caption
222 ..S DTITLE=$P($G(^PXRMD(801.41,IEN,10,SUB,0)),U,6)
223 ..I DTITLE="" S DTITLE=$P($G(^PXRMD(801.41,DSUB,2)),U,4)
224 ..S DNAME=DTITLE
225 .S DNAME=$J("",TAB)_TEXT_DNAME
226 .S:DDIS]"" DNAME=DNAME_" (Disabled)"
227 .S NLINE=NLINE+1
228 .S ^TMP(NODE,$J,NLINE,0)=DNAME
229 .S TEXT=$J("",$L(TEXT))
230 Q
231 ;
232SEQ(SEQ,PIEN) ;Select sequence number to add
233 N X,Y,TEXT,DIR
234 K DIROUT,DIRUT,DTOUT,DUOUT
235 S SEQ=0
236 S DIR(0)="FA0;1;30"
237 S DIR("A")="Enter a new SEQUENCE NUMBER: "
238 S DIR("?")="Enter new sequence number. For detailed help type ??"
239 S DIR("??")=U_"D HELP^PXRMDLG4(1)"
240 D ^DIR K DIR
241 I $D(DIROUT) S DTOUT=1
242 I $D(DTOUT)!($D(DUOUT)) Q
243 ;
244 ;Check that sequence number is new
245 I $D(^TMP("PXRMDLG4",$J,"SEQ",X)) D Q
246 .W !,"Sequence number "_X_" already in use."
247 ;
248 ;Then check that the parent is a group or reminder dialog
249 I X["." D Q:X=""
250 .N CLASS,SUB
251 .;Sequence number of parent
252 .S SUB=$P(X,".",1,$L(X,".")-1)
253 .I $G(SUB)=""!($G(SUB)=0) W !,"Invalid sequence number. A sequence number cannot be less then 1" H 2 Q
254 .;Get IEN of parent dialog or group
255 .S PIEN=$G(^TMP("PXRMDLG4",$J,"SEQ",SUB))
256 .;Validate sequence number
257 .I 'PIEN W !,"Sequence number is not part of an existing group." S X="" Q
258 .;Validate that the parent is a group or reminder dialog
259 .I "RG"'[$P($G(^PXRMD(801.41,PIEN,0)),U,4) D S X="" Q
260 ..W !,"New sequences can only be added to groups or reminder dialogs"
261 .;Disallow adding elements to national dialogs or groups
262 .I $P($G(^PXMRD(801.41,PIEN,100)),U)="N" D Q:X=""
263 ..Q:(DUZ(0)="@")&($G(PXRMINST)=1)
264 ..W !,"Elements cannot be added to a national group" S X=""
265 ;
266 ;If adding to top level parent ien is reminder dialog
267 I X?.N S PIEN=PXRMDIEN
268 ;
269 S SEQ=$P(X,".",$L(X,"."))
270 Q
271 ;
272 ;
273HELP(CALL) ;General help text routine.
274 N HTEXT
275 N DIWF,DIWL,DIWR,IC
276 S DIWF="C75",DIWL=0,DIWR=75
277 ;
278 I CALL=1 D
279 .S HTEXT(1)="Sequence numbers can be added at any level. Specify the full"
280 .S HTEXT(2)="number for the level required (e.g. 15.10.20)."
281 ;
282 D HELP^PXRMEUT(.HTEXT)
283 Q
284 ;
Note: See TracBrowser for help on using the repository browser.