source: WorldVistAEHR/trunk/r/CLINICAL_REMINDERS-PXRM/PXRMEXLB.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: 7.2 KB
RevLine 
[613]1PXRMEXLB ;SLC/PJH - Reminder Dialog Exchange. ;05/16/2007
2 ;;2.0;CLINICAL REMINDERS;**6**;Feb 04, 2005;Build 123
3 ;
4 ;=====================================================================
5 ;
6 ;Build list of dialog components - called once from PXRMEXLC
7 ;-------------------------------
8DBUILD(IND,NITEMS,FILENUM) ;
9 N DARRAY,DDATA,DDLG,DEND,DLOC,DMAP,DNAM,DNODE,DSEQ,DSTRT,DSUB,FILE,JND
10 N REPCNT,RESGRP,TEMPRESL,CNT
11 ;
12 K ^TMP("PXRMEXTMP",$J),^TMP("PXRMEXFND",$J)
13 ;
14 ;Scan dialog components in 120 and save name and type
15 S JND=0
16 F S JND=$O(^PXD(811.8,IEN,120,IND,1,JND)) Q:'JND D
17 .S DDATA=$G(^PXD(811.8,IEN,120,IND,1,JND,0)) Q:DDATA=""
18 .S DNAM=$P(DDATA,U),DSTRT=$P(DDATA,U,2),DEND=$P(DDATA,U,3)
19 .;Extract dialog type and text and findings from exchange file
20 .D DPARSE
21 ;Scan dialog components in 120 and save dialog links
22 S JND="B",REPCNT=0
23 F S JND=$O(^PXD(811.8,IEN,120,IND,1,JND),-1) Q:'JND D
24 .S DDATA=$G(^PXD(811.8,IEN,120,IND,1,JND,0)) Q:DDATA=""
25 .S DSTRT=$P(DDATA,U,2),DEND=$P(DDATA,U,3)
26 .S DDLG=$P(DDATA,U),DSUB=DSTRT+2
27 .I JND=NITEMS D
28 ..S ^TMP("PXRMEXTMP",$J,"PXRMDNAM")=DDLG
29 ..I $P($G(^PXD(811.8,IEN,100,DSUB,0)),";",3)'["100~NATIONAL" Q
30 ..S ^TMP("PXRMEXTMP",$J,"PXRMDNAT")=""
31 .F S DSUB=$O(^PXD(811.8,IEN,100,DSUB)) Q:DSUB>DEND D
32 ..S DNODE=$G(^PXD(811.8,IEN,100,DSUB,0))
33 ..I ($P(DNODE,";")'="801.412")&($P(DNODE,";")'="801.41121")&($P(DNODE,";",3)'["118~") Q
34 ..S FILE=$P(DNODE,";")
35 ..S DNODE=$P(DNODE,";",3)
36 ..;;Modified Exchange to handle dialogs with replacement dialogs
37 ..I $E(DNODE,1,4)="118~" D
38 ...S DNAM=$P(DNODE,"~",2) Q:DNAM=""
39 ...S DLOC=$G(^TMP("PXRMEXTMP",$J,"DLOC",DNAM))
40 ...S REPCNT=REPCNT+1,^TMP("PXRMEXTMP",$J,"DREPL",REPCNT,DDLG)=DNAM_U_DLOC
41 ..I $E(DNODE,1,4)'=".01~" Q
42 ..S DSEQ=$P(DNODE,"~",2) Q:DSEQ=""
43 ..I FILE="801.41121" D Q
44 ...S DNAM=$P(DNODE,"~",2) Q:DNAM=""
45 ...S DLOC=$G(^TMP("PXRMEXTMP",$J,"DLOC",DNAM))
46 ...S CNT=0
47 ...I $D(^TMP("PXRMEXTMP",$J,"DMAP",DDLG))>0 S CNT=$O(^TMP("PXRMEXTMP",$J,"DMAP",DDLG,""),-1)
48 ...S ^TMP("PXRMEXTMP",$J,"DMAP",DDLG,CNT+1)=DNAM_U_DLOC
49 ..S DNODE=$G(^PXD(811.8,IEN,100,DSUB+1,0))
50 ..I ($P(DNODE,";")'="801.412") Q
51 ..S DNODE=$P(DNODE,";",3) I $E(DNODE,1,2)'="2~" Q
52 ..S DNAM=$P(DNODE,"~",2) Q:DNAM=""
53 ..S DLOC=$G(^TMP("PXRMEXTMP",$J,"DLOC",DNAM))
54 ..S ^TMP("PXRMEXTMP",$J,"DMAP",DDLG,DSEQ)=DNAM_U_DLOC
55 ;
56 ;Build index of dialog findings by name
57 N FDATA,FILENAM,FILENUM,FNAME
58 S IND=0
59 F S IND=$O(^PXD(811.8,IEN,120,IND)) Q:'IND D
60 .S FDATA=$G(^PXD(811.8,IEN,120,IND,0)) Q:FDATA=""
61 .S FILENAM=$P(FDATA,U),FILENUM=$P(FDATA,U,2) Q:FILENAM="" Q:'FILENUM
62 .;Ignore reminder dialogs
63 .I FILENAM="REMINDER DIALOG" Q
64 .;Ignore reminder terms
65 .I FILENAM="REMINDER TERM" Q
66 .;Strip off trailing S in finding file name
67 .I $E(FILENAM,$L(FILENAM))="S" S $E(FILENAM,$L(FILENAM))=""
68 .S JND=0
69 .F S JND=$O(^PXD(811.8,IEN,120,IND,1,JND)) Q:'JND D
70 ..S FNAME=$P($G(^PXD(811.8,IEN,120,IND,1,JND,0)),U) Q:FNAME=""
71 ..;Save entry
72 ..S ^TMP("PXRMEXFND",$J,FNAME)=FILENUM_U_FILENAM_U_IND
73 I $D(TEMPRESL)>0 D
74 .S DDLG="" F S DDLG=$O(TEMPRESL(DDLG)) Q:DDLG="" D
75 ..;S ^TMP("PXRMEXTMP",$J,"RESULT",DDLG,TEMPRESL(DDLG))=""
76 ..S DSEQ=$O(^TMP("PXRMEXTMP",$J,"DMAP",DDLG,""),-1)
77 ..S ^TMP("PXRMEXTMP",$J,"DMAP",DDLG,DSEQ+1)=TEMPRESL(DDLG)_U_RESGRP(TEMPRESL(DDLG))
78 Q
79 ;
80 ;Scan exchange file to get dialog fields
81 ;---------------------------------------
82DPARSE N DCNT,DFIND,DFIAD,DFNAM,DFQUIT,DLCT,DLINES,DSUB,DTEXT,DTXT,DTYP
83 ;
84 ;Find where all the field numbers are kept
85 N DARRAY,DDATA,DFNUM,DRAW,DSTRING,RESNAM
86 S DSUB=DSTRT-1,DSTRING=";.01;4;5;15;24;25;55;"
87 ;S DSUB=DSTRT,DSTRING=";4;5;15;24;25;"
88 F S DSUB=$O(^PXD(811.8,IEN,100,DSUB)) Q:'DSUB D Q:DSUB>DEND
89 .S DDATA=$G(^PXD(811.8,IEN,100,DSUB,0)) Q:DDATA=""
90 .I $P(DDATA,";")'=801.41 Q
91 .S DFNUM=$P(DDATA,";",3),DFNUM=$P(DFNUM,"~") Q:DFNUM=""
92 .I DSTRING[(";"_DFNUM_";") S DARRAY(DFNUM)=DSUB
93 .I $P(DDATA,";")="801.41121" S DARRAY(55)=DSUB
94 ;
95 ;Determine dialog component type
96 S DSUB=DARRAY(4) Q:'DSUB
97 S DTYP=$P($G(^PXD(811.8,IEN,100,DSUB,0)),"~",2)
98 I DTYP'["result" S:DTYP[" " DTYP=$P(DTYP," ",2) S:DTYP="value" DTYP="forced"
99 ;
100 ;Initialise text and finding fields
101 S DTXT="*NONE*",DFIND=""
102 ;Get text appropriate for the type of component
103 I ((DTYP="element")!(DTYP="group"))&(DTYP'["result") D
104 .;search for WP text
105 .S DSUB=$G(DARRAY(25)) D:DSUB
106 ..S DTEXT=$P($G(^PXD(811.8,IEN,100,DSUB,0)),";",3) Q:DTEXT=""
107 ..;Get the line count
108 ..S DLINES=$P(DTEXT,"~",3),DCNT=0
109 ..;Get the wp text lines
110 ..F DLCT=DSUB+1:1:DSUB+DLINES D
111 ...S DTEXT=$G(^PXD(811.8,IEN,100,DLCT,0))
112 ...S DCNT=DCNT+1,DTXT(DCNT)=DTEXT
113 ...;Check for embedded TIU templates
114 ...D DTIU(DNAM,DTEXT)
115 ..;Reformat text to 50 characters
116 ..D DWP(.DTXT)
117 ..;Search for Result Group/Element
118 ..S DSUB=$G(DARRAY(55)) I DSUB>0 D
119 ...S RESNAME=$P($P($G(^PXD(811.8,IEN,100,DSUB,0)),";",3),"~",2)
120 ...S TEMPRESL(DNAM)=RESNAME
121 .;Search for finding item
122 .S DSUB=$G(DARRAY(15)) D:DSUB
123 ..S DFIND=$P($G(^PXD(811.8,IEN,100,DSUB,0)),";",3) Q:DFIND=""
124 ..;Finding name
125 ..S DFIND=$P(DFIND,"~",2) Q:DFIND=""
126 ..I $P(DFIND,".")="ICD9" S DFIND=$P(DFIND," ")
127 .;
128 .;Search for additional finding - start after WP text
129 .S DSUB=+$G(DARRAY(25)) D:DSUB
130 ..S DCNT=0,DFQUIT=0
131 ..F DLCT=DSUB+1+DLINES:1 D Q:DFQUIT Q:DLCT>DEND
132 ...S DTEXT=$G(^PXD(811.8,IEN,100,DLCT,0))
133 ...;Ignore line if this is not an additional finding
134 ...I $P(DTEXT,";")'=801.4118 S:$P(DTEXT,";")>801.4118 DFQUIT=1 Q
135 ...S DFNAM=$P(DTEXT,"~",2) Q:DFNAM=""
136 ...I $P(DFNAM,".")="ICD9" S DFNAM=$P(DFNAM," ")
137 ...S DCNT=DCNT+1,DFIAD(DCNT)=DFNAM
138 ;
139 I DTYP["result" D
140 .S DSUB=$G(DARRAY(.01)) Q:'DSUB
141 .S DTEXT=$P($G(^PXD(811.8,IEN,100,DSUB,0)),";",3) Q:DTEXT=""
142 .S DTXT=$P(DTEXT,"~",2)
143 .S RESGRP(DNAM)=DSTRT_U_DEND_U_IND_U_JND
144 ;
145 I DTYP="prompt" D
146 .;search for prompt caption
147 .S DSUB=$G(DARRAY(24)) Q:'DSUB
148 .S DTEXT=$P($G(^PXD(811.8,IEN,100,DSUB,0)),";",3) Q:DTEXT=""
149 .S DTXT=$P(DTEXT,"~",2)
150 ;
151 I DTYP="group" D
152 .;search for group caption
153 .S DSUB=$G(DARRAY(5)) Q:'DSUB
154 .S DTEXT=$P($G(^PXD(811.8,IEN,100,DSUB,0)),";",3) Q:DTEXT=""
155 .S DTXT=$P(DTEXT,"~",2)
156 .Q
157 ;
158 ;Save dialog type
159 S ^TMP("PXRMEXTMP",$J,"DTYP",DNAM)=DTYP
160 ;Save dialog component text (first line only)
161 S ^TMP("PXRMEXTMP",$J,"DTXT",DNAM)=DTXT
162 ;
163 ;Save main finding
164 I DFIND]"" S ^TMP("PXRMEXTMP",$J,"DFND",DNAM,1)=$P(DFIND,".",2,99)
165 ;Save additional findings
166 S DSUB=0
167 F S DSUB=$O(DFIAD(DSUB)) Q:'DSUB D
168 .S ^TMP("PXRMEXTMP",$J,"DFND",DNAM,DSUB+1)=$P(DFIAD(DSUB),".",2,99)
169 ;
170 ;Save additional WP text lines
171 S DSUB=0
172 F S DSUB=$O(DTXT(DSUB)) Q:'DSUB D
173 .S ^TMP("PXRMEXTMP",$J,"DTXT",DNAM,DSUB)=DTXT(DSUB)
174 ;
175 ;Save dialog's position in exchange file
176 S ^TMP("PXRMEXTMP",$J,"DLOC",DNAM)=DSTRT_U_DEND_U_IND_U_JND
177 Q
178 ;
179 ;Extract any TIU templates
180 ;-------------------------
181DTIU(DNAM,TEXT) ;
182 N IC,TCNT,TLIST,TNAM
183 ;Templates are in format {FLD:fldname}
184 S TCNT=0 D TIUXTR^PXRMEXDG("{FLD:","}",TEXT,.TLIST,.TCNT) Q:'TCNT
185 ;
186 F IC=1:1:TCNT D
187 .S TNAM=$G(TLIST(TCNT)) Q:TNAM=""
188 .S ^TMP("PXRMEXTMP",$J,"DTIU",DNAM,TNAM)=""
189 Q
190 ;
191 ;Process WP fields
192 ;-----------------
193DWP(TEXT) ;
194 N DIWF,DIWL,DIWR,IC,X
195 S DIWF="C50",DIWL=0,DIWR=50
196 ;
197 K ^UTILITY($J,"W")
198 S IC=""
199 F S IC=$O(TEXT(IC)) Q:IC="" D
200 .S X=TEXT(IC)
201 .D ^DIWP
202 ;
203 K TEXT
204 S IC=0
205 F S IC=$O(^UTILITY($J,"W",0,IC)) Q:IC="" D
206 .S DTEXT=$G(^UTILITY($J,"W",0,IC,0))
207 .I IC=1 S TEXT=DTEXT Q
208 .S TEXT(IC-1)=DTEXT
209 ;
210 K ^UTILITY($J,"W")
211 Q
Note: See TracBrowser for help on using the repository browser.