source: WorldVistAEHR/trunk/r/CLINICAL_REMINDERS-PXRM/PXRMEXLB.m@ 1259

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

revised back to 6/30/08 version

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