source: WorldVistAEHR/trunk/r/CLINICAL_REMINDERS-PXRM/PXRMEXDG.m@ 1006

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

revised back to 6/30/08 version

File size: 6.3 KB
Line 
1PXRMEXDG ;SLC/PJH - Reminder Dialog Exchange index build ;02/25/2004
2 ;;2.0;CLINICAL REMINDERS;;Feb 04, 2005
3 ;
4 ;=====================================================================
5DIALOG(RIEN,DLIST,FLIST,OLIST,TLIST) ;
6 ;
7 ;Routine to get dialog details for a given reminder
8 ;
9 ;Called as DIALOG^PXRMEXDG(RIEN,.DLIST,.FLIST)
10 ;
11 ;RIEN - Reminder IEN
12 ;DLIST - List of dialogs (components first)
13 ;FLIST - Finding list used by PXRMEXPR
14 ;OLIST - List of embedded TIU objects
15 ;TLIST - List of embedded TIU templates
16 ;
17 ;Initialize
18 K DLIST
19 N DARRAY,DCNT,DIALOG,DIEN,FCNT,FINDING,OCNT,RCNT,RESULT,TEMP
20 ;Check if reminder exists
21 Q:'$D(^PXD(811.9,RIEN,0))
22 ;Get dialog ien from reminder definition
23 S DIEN=$P($G(^PXD(811.9,RIEN,51)),U) Q:'DIEN
24 ;Check dialog pointer is valid
25 Q:'$D(^PXRMD(801.41,DIEN))
26 ;Dialog and Finding count
27 S DCNT=0,FCNT=0,RCNT=0,TCNT=0
28 ;Get details
29 D DGET(DIEN)
30 ;
31 ;Now build the dialog list (components first)
32 S DCNT="",OCNT=0
33 F S DCNT=$O(DARRAY(DCNT),-1) Q:'DCNT D
34 .;Ignore dialogs previously encountered
35 .S DIEN=DARRAY(DCNT) Q:$D(DIALOG(DIEN))
36 .;Save dialog in output array
37 .S OCNT=OCNT+1,DIALOG(DIEN)="",TEMP("DIALOG",OCNT)=DIEN
38 ;
39 ;Save the dialog and result details to DLIST
40 N CNT,COUNT,DTYP
41 S COUNT=0
42 F DTYP="RESULT","DIALOG" D
43 .F CNT=1:1 S DIEN=$G(TEMP(DTYP,CNT)) Q:'DIEN D
44 ..S COUNT=COUNT+1,DLIST("DIALOG",COUNT,DIEN)=""
45 ;
46 I COUNT>0 S DLIST("DIALOG")=801.41
47 ;
48 ;Add Dialog Findings to FLIST if not aready present
49 N DIC,DO,IEN,FNAME,FNUM,SUB
50 S SUB=0
51 F S SUB=$O(TEMP("FINDING",SUB)) Q:'SUB D
52 .S IEN=$P(TEMP("FINDING",SUB),";"),DIC=U_$P(TEMP("FINDING",SUB),";",2)
53 .K DO D DO^DIC1
54 .S FNUM=+DO(2),FNAME=$P(DO,U) I ('FNUM)!(FNAME="") Q
55 .;Check if present in FLIST
56 .I $D(FLIST(FNAME,"F",IEN)) Q
57 .;Otherwise add to list
58 .S:'$D(FLIST(FNAME)) FLIST(FNAME)=FNUM S FLIST(FNAME,"F",IEN)=""
59 .;Add the Health Factor category to FLIST
60 .I FNAME="HEALTH FACTORS" D
61 ..N HFCAT
62 ..S HFCAT=$P($G(^AUTTHF(IEN,0)),U,3) S:HFCAT FLIST(FNAME,"C",HFCAT)=""
63 ;
64 ;Store any TIU components
65 N GLOB,DIEN,CNT
66 ;Set global for search
67 S GLOB="^PXRMD(801.41,"
68 ;Search through all component dialogs
69 S CNT=0
70 F S CNT=$O(DLIST("DIALOG",CNT)) Q:'CNT D
71 .S DIEN=$O(DLIST("DIALOG",CNT,"")) Q:'DIEN
72 .;Search Dialog Text for TIU Objects and Templates
73 .D TIUSRCH(GLOB,DIEN,25,.OLIST,.TLIST)
74 .;Search P/N Text for TIU Objects and Templates
75 .D TIUSRCH(GLOB,DIEN,35,.OLIST,.TLIST)
76 ;
77 Q
78 ;
79 ;Get the dialog components
80 ;-------------------------
81DGET(D0) ;Save dialog ien
82 N D1
83 I $G(D0)=83
84 I $G(^PXRMD(801.41,D0,49))'="",$P(^PXRMD(801.41,D0,49),U,3)>0 D
85 .S D1=$P($G(^PXRMD(801.41,D0,49)),U,3) D DGET1(D0) D DGET1(D1)
86 E D DGET1(D0)
87 Q
88DGET1(D0) ;
89 S DCNT=DCNT+1,DARRAY(DCNT)=D0
90 ;And details (except for reminder dialog)
91 I DCNT>1 D
92 .;Finding items
93 .D DFIND(D0)
94 .;Additional Finding Items
95 .D DFINDA(D0)
96 .;Result groups
97 .D DRESULT(D0)
98 ;
99 ;Dialog components
100 N DCOMP,DCOMP1,DDATA,DSUB
101 S DSUB=0
102 F S DSUB=$O(^PXRMD(801.41,D0,10,DSUB)) Q:'DSUB D
103 .;Get any component dialogs
104 .S DCOMP=$P($G(^PXRMD(801.41,D0,10,DSUB,0)),U,2) Q:'DCOMP
105 .;If component exists get sub-components
106 .S DDATA=$G(^PXRMD(801.41,DCOMP,0)) Q:DDATA=""
107 .;Exclude national PXRM prompts
108 .I $E(DDATA,1,4)="PXRM",$P($G(^PXRMD(801.41,DCOMP,100)),U)="N" Q
109 .;Sub-components
110 .D DGET(DCOMP)
111 .;I $G(DCOMP1)'="" D DGET(DCOMP1) S DCOMP1=""
112 Q
113 ;
114 ;Build list of finding items
115 ;---------------------------
116DFIND(DIEN) ;
117 N FIND,FIEN,FGLOB,FNAM
118 ;Finding Item
119 S FIND=$P($G(^PXRMD(801.41,DIEN,1)),U,5)
120 ;If a finding item exists check and save
121LOOP ;
122 I FIND]"" D
123 .;Finding item defined
124 .S FIEN=$P(FIND,";"),FGLOB=$P(FIND,";",2) Q:'FIEN Q:FGLOB=""
125 .;And finding item exists
126 .Q:'$D(@(U_FGLOB_FIEN_",0)"))
127 .;Finding name
128 .S FNAM=$P($G(@(U_FGLOB_FIEN_",0)")),U) S:FNAM="" FNAM="???"
129 .;And not previously saved
130 .I '$D(FINDING(FIND)) D
131 ..S FCNT=FCNT+1,FINDING(FIND)="",TEMP("FINDING",FCNT)=FIND
132 I $G(^PXRMD(801.41,DIEN,49))'="",$P(^PXRMD(801.41,DIEN,49),U)>0 D
133 .S FIND=$P(^PXRMD(801.41,DIEN,49),U)
134 .I $D(FLIST("REMINDER TERM","F",FIND)) Q
135 .I '$D(FLIST("REMINDER TERM")) S FLIST("REMINDER TERM")="811.5"
136 .S FLIST("REMINDER TERM","F",FIND)=""
137 .D GETTFIND^PXRMEXPR(.FLIST)
138 Q
139 ;
140 ;Build list of additional findings
141 ;---------------------------------
142DFINDA(DIEN) ;
143 N FIND,FIEN,FGLOB,FNAM,FSUB
144 S FSUB=0
145 F S FSUB=$O(^PXRMD(801.41,DIEN,3,FSUB)) Q:'FSUB D
146 .;Additional Finding Item
147 .S FIND=$P($G(^PXRMD(801.41,DIEN,3,FSUB,0)),U)
148 .;If a finding item exists check and save
149 .I FIND]"" D
150 ..;Finding item defined
151 ..S FIEN=$P(FIND,";"),FGLOB=$P(FIND,";",2) Q:'FIEN Q:FGLOB=""
152 ..;And finding item exists
153 ..Q:'$D(@(U_FGLOB_FIEN_",0)"))
154 ..;Finding name
155 ..S FNAM=$P($G(@(U_FGLOB_FIEN_",0)")),U) S:FNAM="" FNAM="???"
156 ..;And not previously saved
157 ..I '$D(FINDING(FIND)) D
158 ...S FCNT=FCNT+1,FINDING(FIND)="",TEMP("FINDING",FCNT)=FIND
159 Q
160 ;
161 ;Build list of result groups
162 ;---------------------------
163DRESULT(DIEN) ;
164 N RIEN
165 ;Result Group/Element pointer
166 S RIEN=$P($G(^PXRMD(801.41,DIEN,0)),U,15) Q:'RIEN Q:$D(RESULT(RIEN))
167 ;Result group compoments
168 N DSUB,REIEN
169 S DSUB=0
170 F S DSUB=$O(^PXRMD(801.41,RIEN,10,DSUB)) Q:'DSUB D
171 .;Get result element
172 .S REIEN=$P($G(^PXRMD(801.41,RIEN,10,DSUB,0)),U,2) Q:'REIEN
173 .Q:'$D(^PXRMD(801.41,REIEN,0))
174 .;If element exists get save it
175 .S RCNT=RCNT+1,OUTPUT("RESULT",RCNT)=REIEN
176 ;
177 ;Save result group
178 S RCNT=RCNT+1,RESULT(RIEN)="",TEMP("RESULT",RCNT)=RIEN
179 Q
180 ;
181 ;Extract TIU Objects/Templates from any WP text
182 ;----------------------------------------------
183TIUSRCH(GLOB,IEN,NODE,OLIST,TLIST) ;
184 N OCNT,TCNT,TEXT
185 ;Add to existing arrays
186 S OCNT=+$O(OLIST(""),-1),TCNT=+$O(TLIST(""),-1),SUB=0
187 ;Scan WP fields
188 F S SUB=$O(@(GLOB_IEN_","_NODE_","_SUB_")")) Q:'SUB D
189 .;Get individual line
190 .S TEXT=$G(@(GLOB_IEN_","_NODE_","_SUB_",0)")) Q:TEXT=""
191 .;Most text lines will have no TIU link so ignore them
192 .I (TEXT'["|")&(TEXT'["{FLD:") Q
193 .;Templates are in format {FLD:fldname} (only applies to dialogs)
194 .I GLOB[801.41 D TIUXTR("{FLD:","}",TEXT,.TLIST,.TCNT)
195 .;Objects are in format |Objectname|
196 .D TIUXTR("|","|",TEXT,.OLIST,.OCNT)
197 Q
198 ;
199TIUXTR(SRCH,SRCH1,TEXT,OUTPUT,CNT) ;
200 N EXIST,IC,TXT,ONAME
201 S TXT=TEXT
202 F D Q:TXT'[SRCH
203 .S TXT=$E(TXT,$F(TXT,SRCH),$L(TXT)) Q:TXT'[SRCH1
204 .S ONAME=$P(TXT,SRCH1) Q:ONAME=""
205 .;Check if already selected
206 .S EXIST=0,IC=0
207 .F S IC=$O(OUTPUT(IC)) Q:'IC Q:EXIST D
208 ..I $G(OUTPUT(IC))=ONAME S EXIST=1
209 .;Save array of object/template names
210 .I 'EXIST S CNT=CNT+1,OUTPUT(CNT)=ONAME
211 Q
Note: See TracBrowser for help on using the repository browser.