source: FOIAVistA/trunk/r/CLINICAL_REMINDERS-PXRM/PXRMEXD1.m@ 767

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

initial load of FOIAVistA 6/30/08 version
File size: 8.2 KB
Line 
1PXRMEXD1 ;SLC/PKR,AJP - Reminder Exchange dialog utilities. ;09/07/2007
2 ;;2.0;CLINICAL REMINDERS;**6**;Feb 04, 2005;Build 123
3 ;
4 ;======================================
5BLDDISP(VIEW) ;Build ListMan array. Information about the dialog is passed
6 ;in ^TMP("PXRMEXTMP",$J) which is built by PXRMEXLB which is
7 ;called by CDISP^PXRMEXLC.
8 K ^TMP("PXRMEXLD",$J)
9 N DDATA,DDLG,DEND,DREP,DSTRT,FILENUM,IND,JND,NLINE,NSEL
10 S (NLINE,NSEL)=0,FILENUM=801.41
11 S DDLG=$G(^TMP("PXRMEXTMP",$J,"PXRMDNAM")) Q:DDLG=""
12 ;Save reminder dialog
13 S DDATA=^TMP("PXRMEXTMP",$J,"DLOC",DDLG)
14 S DSTRT=$P(DDATA,U,1),DEND=$P(DDATA,U,2)
15 S IND=$P(DDATA,U,3),JND=$P(DDATA,U,4),DREP=""
16 D DLINE(VIEW,.NLINE,DDLG,"","")
17 S NLINE=NLINE+1,^TMP("PXRMEXLD",$J,NLINE,0)=$J("",79)
18 S ^TMP("PXRMEXLD",$J,"IDX",NLINE,NSEL)=""
19 ;Process components
20 D DCMP(VIEW,.NLINE,DDLG,"")
21 ;Process replacement elements
22 I $D(^TMP("PXRMEXTMP",$J,"DREPL"))>0 D DREPL(VIEW,.NLINE)
23 S ^TMP("PXRMEXLD",$J,"VALMCNT")=NLINE
24 Q
25 ;
26 ;======================================
27CHKREPL(DLG) ;
28 N CNT,RESULT
29 S (CNT,RESULT)=0
30 F S CNT=$O(^TMP("PXRMEXTMP",$J,"DREPL",CNT)) Q:CNT'>0!(RESULT>0) D
31 .I DLG=$O(^TMP("PXRMEXTMP",$J,"DREPL",CNT,"")) S RESULT=CNT Q
32 Q RESULT
33 ;
34 ;======================================
35DCMP(VIEW,NLINE,DLG,LEV) ;Save details of dialog components for display
36 N DDATA,DEND,DNAM,DREP,DSEQ,DSTRT,IND,JND,LAST
37 S (DSEQ,LAST)=0
38 F S DSEQ=$O(^TMP("PXRMEXTMP",$J,"DMAP",DLG,DSEQ)) Q:'DSEQ D
39 .S DDATA=^TMP("PXRMEXTMP",$J,"DMAP",DLG,DSEQ)
40 .S DNAM=$P(DDATA,U),DSTRT=$P(DDATA,U,2),DEND=$P(DDATA,U,3) Q:DNAM=""
41 .S IND=$P(DDATA,U,4),JND=$P(DDATA,U,5)
42 .;Check if this component has been replaced
43 .S DREP=$G(PXRMNMCH(FILENUM,DNAM)) I DREP=DNAM S DREP=""
44 .;Save line in workfile
45 .S NUM=DSEQ
46 .I +LEV>0,NUM>0,$E(LEV,$L(LEV))'="." S LEV=LEV_"."
47 .D DLINE(VIEW,.NLINE,DNAM,LEV,NUM) Q:DREP'=""
48 .I $D(^TMP("PXRMEXTMP",$J,"DMAP",DNAM)) D DCMP(VIEW,.NLINE,DNAM,LEV_DSEQ_".")
49 .;Extra line feed
50 .I LEV="" D
51 ..S NLINE=NLINE+1,^TMP("PXRMEXLD",$J,NLINE,0)=$J("",79)
52 ..S ^TMP("PXRMEXLD",$J,"IDX",NLINE,NSEL)=""
53 I $G(REPL)["R" D
54 .S NLINE=NLINE+1,^TMP("PXRMEXLD",$J,NLINE,0)=$J("",79)
55 .S ^TMP("PXRMEXLD",$J,"IDX",NLINE,NSEL)=""
56 Q
57 ;
58 ;======================================
59DLINE(VIEW,NLINE,DNAM,LEV,DSEQ) ;Update workfile
60 ;Check if standard PXRM prompt
61 N DPXRM
62 S DPXRM=0
63 ;S DPXRM=$$PXRM^PXRMEXID(DNAM)
64 ;Ignore PXRM prompts if doing a finding view (DF)
65 I VIEW>1,DPXRM Q
66 ;
67 N DEXIST,DTXT,DTYP,EXIST,ITEM,LEVSEQ,PXRMEXRP,SEP,TEMP,X
68 S ITEM=""
69 I DPXRM=0 S NSEL=NSEL+1,ITEM=NSEL
70 S NLINE=NLINE+1,SEP=$E(LEV,$L(LEV)),DEXIST=0
71 S LEVSEQ=LEV_DSEQ
72 S TEMP=$J(ITEM,3)_$J("",4)_LEV_DSEQ
73 ;Determine type
74 S DTYP=$G(^TMP("PXRMEXTMP",$J,"DTYP",DNAM))
75 I DTYP["result" S DTYP=$$STRREP^PXRMUTIL(DTYP,"result","rs.")
76 ;Dialog component display
77 I (VIEW'=1) D
78 .I DTYP["rs." D Q
79 ..F X=1:1:$L(TEMP) S $E(TEMP,X)=" "
80 ..S TEMP=TEMP_$J("",12+$L(SEP)-$L(TEMP))_$E(DNAM,1,50)
81 .I $L(TEMP)<13 S TEMP=TEMP_$J("",12+$L(SEP)-$L(TEMP))_$E(DNAM,1,50)
82 .E S TEMP=TEMP_" "_$E(DNAM,1,50)
83 I VIEW=1 D
84 .I DTYP]"" S DTXT=$G(^TMP("PXRMEXTMP",$J,"DTXT",DNAM))
85 .I DTYP="" S DTXT=DNAM
86 .I DREP'="" S DTXT=DNAM
87 .I $L(TEMP)<13 S TEMP=TEMP_$J("",12+$L(SEP)-$L(TEMP))_$E(DTXT,1,50)
88 .E S TEMP=TEMP_" "_$E(DTXT,1,50)
89 ;Check for replacements
90 I $D(^TMP("PXRMEXTMP",$J,"DREPL"))>0 D
91 .I $$CHKREPL(DNAM)>0 D
92 ..S TEMP=TEMP_"*"
93 ..S TLEV=$S($E(LEVSEQ,$L(LEVSEQ))=".":$E(LEVSEQ,1,$L(LEVSEQ)-1),1:LEVSEQ)
94 ..S PXRMEXRP(DNAM)=""
95 ;Add Type
96 S TEMP=TEMP_$J("",65-$L(TEMP))_DTYP
97 ;Exists flag
98 S DEXIST=$$EXISTS^PXRMEXIU(801.41,DNAM)
99 I DEXIST S TEMP=TEMP_$J("",77-$L(TEMP))_"X"
100 S ^TMP("PXRMEXLD",$J,NLINE,0)=TEMP
101 ;
102 ;Set up selection index
103 S ^TMP("PXRMEXLD",$J,"IDX",NLINE,NSEL)="" Q:DPXRM=1
104 ;Store the file number, start and stop line in the exchange file.
105 S ^TMP("PXRMEXLD",$J,"SEL",NSEL)=FILENUM_U_DSTRT_U_DEND_U_DEXIST_U_IND_U_JND_U_DNAM
106 ;Insert additional text lines
107 I VIEW=1,DREP="" D
108 .N DSUB,DTXT,FILENUM
109 .S DSUB=0,FILENUM=8927.1
110 .F S DSUB=$O(^TMP("PXRMEXTMP",$J,"DTXT",DNAM,DSUB)) Q:'DSUB D
111 ..S DTXT=$G(^TMP("PXRMEXTMP",$J,"DTXT",DNAM,DSUB)),NLINE=NLINE+1
112 ..S ^TMP("PXRMEXLD",$J,NLINE,0)=$J("",12+$L(SEP))_$E(DTXT,1,50)
113 ..S ^TMP("PXRMEXLD",$J,"IDX",NLINE,NSEL)=""
114 .;TIU template changes
115 .I $D(PXRMNMCH(FILENUM)),$D(^TMP("PXRMEXTMP",$J,"DTIU",DNAM)) D
116 ..N TEMP,TNAM,TNNAM
117 ..S TNAM=""
118 ..F S TNAM=$O(^TMP("PXRMEXTMP",$J,"DTIU",DNAM,TNAM)) Q:TNAM="" D
119 ...S TNNAM=$G(PXRMNMCH(FILENUM,TNAM)) Q:TNNAM=""
120 ...S NLINE=NLINE+1,^TMP("PXRMEXLD",$J,NLINE,0)=$J("",79)
121 ...S ^TMP("PXRMEXLD",$J,"IDX",NLINE,NSEL)=""
122 ...S TEMP=$J("",12+$L(SEP))_"(TIU template "_TNAM_" copied to "_TNNAM_")"
123 ...S NLINE=NLINE+1,^TMP("PXRMEXLD",$J,NLINE,0)=TEMP
124 ...S ^TMP("PXRMEXLD",$J,"IDX",NLINE,NSEL)=""
125 ...S NLINE=NLINE+1,^TMP("PXRMEXLD",$J,NLINE,0)=$J("",79)
126 ...S ^TMP("PXRMEXLD",$J,"IDX",NLINE,NSEL)=""
127 ;Insert finding items
128 I VIEW=2,("element;group"[DTYP),"rs."'[DTYP,DREP="" D
129 .N DSUB,FDATA,FILENUM,FLIT,FLONG,FNAME,FOUND,FREP,FTAB,FTYP,TEMP
130 .;Findings and additional findings
131 .S DSUB=0,FOUND=0
132 .F S DSUB=$O(^TMP("PXRMEXTMP",$J,"DFND",DNAM,DSUB)) Q:'DSUB D
133 ..S FNAME=$G(^TMP("PXRMEXTMP",$J,"DFND",DNAM,DSUB)) Q:FNAME=""
134 ..S FDATA=$G(^TMP("PXRMEXFND",$J,FNAME))
135 ..S FILENUM=$P(FDATA,U),FTYP=$P(FDATA,U,2) Q:'FILENUM
136 ..S FREP=$G(PXRMNMCH(FILENUM,FNAME)) I FREP=FNAME S FREP=""
137 ..S NLINE=NLINE+1,EXIST=$$EXISTS^PXRMEXIU(FILENUM,FNAME),FOUND=1
138 ..I DSUB=1 S FLIT="Finding: "
139 ..I DSUB>1 S FLIT="Add. Finding: "
140 ..S FLONG=0 I $L(FLIT_FNAME_" ("_FTYP_")")>60 S FLONG=1
141 ..I 'FLONG S FNAME=FLIT_FNAME_" ("_FTYP_")"
142 ..I FLONG S FNAME=FLIT_FNAME
143 ..S TEMP=$J("",12+$L(SEP))_$E(FNAME,1,60)_$J("",60-$L(FNAME))
144 ..I EXIST S TEMP=TEMP_$J("",77-$L(TEMP))_"X"
145 ..S ^TMP("PXRMEXLD",$J,NLINE,0)=TEMP
146 ..S ^TMP("PXRMEXLD",$J,"IDX",NLINE,NSEL)=""
147 ..I FLONG D
148 ...S NLINE=NLINE+1
149 ...S FTAB=$S(DSUB=1:21,1:26)
150 ...S ^TMP("PXRMEXLD",$J,NLINE,0)=$J("",FTAB)_"("_FTYP_")"
151 ...S ^TMP("PXRMEXLD",$J,"IDX",NLINE,NSEL)=""
152 ..I FREP'="" D
153 ...S NLINE=NLINE+1
154 ...S FTAB=$S(DSUB=1:21,1:26)
155 ...S ^TMP("PXRMEXLD",$J,NLINE,0)=$J("",FTAB)_"(Replaced by "_FREP_")"
156 ...S ^TMP("PXRMEXLD",$J,"IDX",NLINE,NSEL)=""
157 .;If no findings
158 .I 'FOUND D
159 ..S NLINE=NLINE+1
160 ..S ^TMP("PXRMEXLD",$J,NLINE,0)=$J("",12+$L(SEP))_"Finding: *NONE*"
161 ..S ^TMP("PXRMEXLD",$J,"IDX",NLINE,NSEL)=""
162 ;
163 ;Usage screen
164 I VIEW=4,DREP="" D
165 .N DOTHER,DTXT,DTYPE,OTHER,TYPE
166 .D OTHER(DNAM,.DOTHER) Q:'$D(DOTHER)
167 .S OTHER=""
168 .F S OTHER=$O(DOTHER(OTHER)) Q:OTHER="" D
169 ..S TYPE=DOTHER(OTHER),NLINE=NLINE+1,DTYPE="REMINDER DIALOG"
170 ..I TYPE="G" S DTYPE="DIALOG GROUP"
171 ..I TYPE="E" S DTYPE="DIALOG ELEMENT"
172 ..S DTXT="USED BY: "_OTHER_" ("_DTYPE_")"
173 ..S ^TMP("PXRMEXLD",$J,NLINE,0)=$J("",12+$L(SEP))_DTXT
174 ..S ^TMP("PXRMEXLD",$J,"IDX",NLINE,NSEL)=""
175 Q
176 ;
177 ;======================================
178DREPL(VIEW,NLINE) ;Build replacement elements/groups for List Man display.
179 N CNT,DLG,DDATA,DDLG,DEND,DNAM,DREP,DSTRT,IND,JND,LEV,PXRMEXOR,STR,TEMP
180 S NLINE=NLINE+1,^TMP("PXRMEXLD",$J,NLINE,0)=$J("",79)
181 S STR="" F IND=1:1:30 S STR=STR_"-"
182 S NLINE=NLINE+1,^TMP("PXRMEXLD",$J,NLINE,0)=$J(STR_" REPLACEMENT ITEMS "_STR,79)
183 S (CNT,LEV)=0
184 F S CNT=$O(^TMP("PXRMEXTMP",$J,"DREPL",CNT)) Q:CNT'>0 D
185 .S DLG=$O(^TMP("PXRMEXTMP",$J,"DREPL",CNT,"")) Q:DLG=""
186 .S DDATA=$G(^TMP("PXRMEXTMP",$J,"DREPL",CNT,DLG)) Q:DDATA=""
187 .S DNAM=$P(DDATA,U),DSTRT=$P(DDATA,U,2),DEND=$P(DDATA,U,3) Q:DNAM=""
188 .I $D(PXRMEXOR(DNAM))>0 Q
189 .S PXRMEXOR(DNAM)=""
190 .S IND=$P(DDATA,U,4),JND=$P(DDATA,U,5)
191 .;Check if this component has been replaced
192 .S LEV=LEV+1
193 .S DREP=$G(PXRMNMCH(FILENUM,DNAM)) I DREP=DNAM S DREP=""
194 .;Save line in workfile
195 .S NLINE=NLINE+1,^TMP("PXRMEXLD",$J,NLINE,0)=$J("",79)
196 .S ^TMP("PXRMEXLD",$J,"IDX",NLINE,NSEL)=""
197 .D DLINE(VIEW,.NLINE,DNAM,LEV,"")
198 .I $D(^TMP("PXRMEXTMP",$J,"DMAP",DNAM)) D DCMP(VIEW,.NLINE,DNAM,LEV)
199 Q
200 ;
201 ;======================================
202OTHER(NAME,LIST) ;Check if used by other dialogs
203 N DDATA,DIEN,DNAME,DTYP,IEN
204 S IEN=$O(^PXRMD(801.41,"B",NAME,0)) Q:'IEN
205 ;Check if used by other dialogs
206 I '$D(^PXRMD(801.41,"AD",IEN)) Q
207 ;Build list of dialogs using this component
208 S DIEN=0
209 F S DIEN=$O(^PXRMD(801.41,"AD",IEN,DIEN)) Q:'DIEN D
210 .S DDATA=$G(^PXRMD(801.41,DIEN,0)) Q:DDATA=""
211 .S DNAME=$P(DDATA,U),DTYP=$P(DDATA,U,4) Q:DNAME=""
212 .;Include only dialogs that are not part of this reminder dialog
213 .I $D(^TMP("PXRMEXTMP",$J,"DMAP",DNAME)) Q
214 .S LIST(DNAME)=DTYP
215 Q
216 ;
Note: See TracBrowser for help on using the repository browser.