source: FOIAVistA/trunk/r/CLINICAL_REMINDERS-PXRM/PXRMEXPR.m@ 1119

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

initial load of FOIAVistA 6/30/08 version

File size: 7.6 KB
Line 
1PXRMEXPR ; SLC/PKR/PJH - Routines to create packed reminder definitions. ;12/12/2006
2 ;;2.0;CLINICAL REMINDERS;**6**;Feb 04, 2005;Build 123
3 ;===============================================================
4ADDFILE(FLIST,ROOT,FILENAME) ;Add a file to the list of finding files.
5 N DIC,DO,FILENUM
6 S DIC="^"_ROOT
7 K DO
8 D DO^DIC1
9 S FILENUM=+DO(2)
10 S FILENAME=$P(DO,U,1)
11 S FLIST(FILENAME)=FILENUM
12 Q
13 ;
14 ;===============================================================
15ADDFIND(FLIST,FILENAME,IEN) ;Add a finding to the list of findings.
16 S FLIST(FILENAME,"F",IEN)=""
17 ;Make sure categories are included for any health factors and they
18 ;come first in the list of health factors.
19 I FILENAME="HEALTH FACTORS" D
20 . N CAT
21 . S CAT=$P(^AUTTHF(IEN,0),U,3)
22 . S FLIST(FILENAME,"C",CAT)=""
23 Q
24 ;
25 ;===============================================================
26BLDSPON(RIEN,FINDLIST,SPONLIST) ;Build the sponsor list.
27 N DIEN,IEN,IND,IND0
28 ;Start with the definition.
29 D GETSPON(811.9,RIEN,.SPONLIST)
30 ;If there is a dialog add it.
31 ;S DIEN=+$P($G(^PXD(811.9,RIEN,51)),U,1)
32 ;I DIEN>0 D GETSPON(801.41,DIEN,.SPONLIST)
33 ;Go through the finding list to find additional sponsors.
34 S IND=""
35 F S IND=$O(FINDLIST(IND)) Q:IND="" D
36 . S FILENUM=FINDLIST(IND)
37 . I (FILENUM'<800)&(FILENUM'>811.9) D
38 .. S IND0=""
39 .. F S IND0=$O(FINDLIST(IND,IND0)) Q:IND0="" D
40 ... S IEN=""
41 ... F S IEN=+$O(FINDLIST(IND,IND0,IEN)) Q:IEN=0 D
42 .... D GETSPON(FILENUM,IEN,.SPONLIST)
43 ;Add any associated sponsors to the begining of the list.
44 S IND=""
45 F S IND=$O(SPONLIST("S",IND)) Q:IND="" D
46 . S IND0=0
47 . F S IND0=+$O(^PXRMD(811.6,IND,2,IND0)) Q:IND0=0 D
48 .. S IEN=+^PXRMD(811.6,IND,2,IND0,0)
49 .. S SPONLIST("A",IEN)=""
50 Q
51 ;
52 ;===============================================================
53BLDTEXT(TMPIND) ;Combine the source information and the user's input into the
54 ;"TEXT" array.
55 N IC,IND
56 S (IC,IND)=0
57 F S IC=$O(^TMP(TMPIND,$J,"SRC",IC)) Q:+IC=0 D
58 . S IND=IND+1
59 . S ^TMP(TMPIND,$J,"TEXT",1,IND)=^TMP(TMPIND,$J,"SRC",IC)
60 ;
61 S IC=0
62 F S IC=$O(^TMP(TMPIND,$J,"TXT",1,IC)) Q:+IC=0 D
63 . S IND=IND+1
64 . S ^TMP(TMPIND,$J,"TEXT",1,IND)=^TMP(TMPIND,$J,"TXT",1,IC,0)
65 Q
66 ;
67 ;===============================================================
68GETDFIND(RIEN,FLIST) ;Build the list of definition findings.
69 ;FLIST has the format FLIST(FILENAME)=file number, and for each
70 ;finding from the file FLIST(FILENAME,"F",IEN)="". For Health Factors
71 ;category entries are FLIST(FILENAME,"C",IEN)="".
72 N FILENAME,IEN,ROOT
73 S ROOT=""
74 F S ROOT=$O(^PXD(811.9,RIEN,20,"E",ROOT)) Q:ROOT="" D
75 . D ADDFILE(.FLIST,ROOT,.FILENAME)
76 . S IEN=0
77 . F S IEN=$O(^PXD(811.9,RIEN,20,"E",ROOT,IEN)) Q:+IEN=0 D
78 .. D ADDFIND(.FLIST,FILENAME,IEN)
79 Q
80 ;
81 ;===============================================================
82GETSPON(FILENUM,IEN,SPONLIST) ;Add sponsors to the sponsor list.
83 N ENTRY,ROOT,SPONSOR
84 S ROOT=$$GET1^DID(FILENUM,"","","GLOBAL NAME")
85 S ENTRY=ROOT_IEN_",100)"
86 S ENTRY=$G(@ENTRY)
87 S SPONSOR=$P(ENTRY,U,2)
88 I SPONSOR'="" S SPONLIST("S",SPONSOR)=""
89 Q
90 ;
91 ;===============================================================
92GETTFIND(FLIST) ;If there are any terms in the list of findings go through
93 ;them and add the mapped findings to the list of findings.
94 I '$D(FLIST("REMINDER TERM")) Q
95 N FILENAME,ROOT,TIEN
96 S TIEN=0
97 F S TIEN=$O(FLIST("REMINDER TERM","F",TIEN)) Q:+TIEN=0 D
98 . S ROOT=""
99 . F S ROOT=$O(^PXRMD(811.5,TIEN,20,"E",ROOT)) Q:ROOT="" D
100 .. D ADDFILE(.FLIST,ROOT,.FILENAME)
101 .. S IEN=0
102 .. F S IEN=$O(^PXRMD(811.5,TIEN,20,"E",ROOT,IEN)) Q:+IEN=0 D
103 ... D ADDFIND(.FLIST,FILENAME,IEN)
104 Q
105 ;
106 ;===============================================================
107GETTEXT(RIEN,TMPIND,INDEX) ;Let the user input some text.
108 N DIC,DWLW,DWPK
109 ;If this is the description text, load the reminder description as
110 ;the default.
111 S RIEN=+RIEN
112 I RIEN>0 M ^TMP(TMPIND,$J,INDEX,1)=^PXD(811.9,RIEN,1)
113 S DIC="^TMP(TMPIND,$J,"""_INDEX_""",1,"
114 S DWLW=72
115 S DWPK=1
116 D EN^DIWE
117 Q
118 ;
119 ;===============================================================
120PACK(RTP,TMPIND) ;Create the packed reminder, store it in
121 ;^TMP(TMPIND,$J). TMPIND should be namespaced and set by the caller.
122 ;Save the source information
123 I +RTP'>0 Q
124 K ^TMP(TMPIND,$J),^TMP("PXRMEXCS",$J)
125 D PUTSRC(RTP,TMPIND)
126 ;
127 ;Have the user input text that describes the reminder.
128 W !,"Enter a description of the reminder you are packing." H 3
129 D GETTEXT(RTP,TMPIND,"DESC")
130 ;
131 ;Have the user input keywords for indexing the reminder.
132 W !,"Enter keywords or phrases to help index the reminder you are packing."
133 W !,"Separate the keywords or phrases on each line with commas." H 3
134 D GETTEXT(0,TMPIND,"KEYWORD")
135 ;
136 ;Combine the source and input text into the "TEXT" array.
137 D BLDTEXT(TMPIND)
138 ;
139 W !,"Packing the reminder ... "
140 ;Build lists of the various reminder components.
141 N CF,IEN,IND0,FINDLIST,FILELIST,FILENAME,FILENUM,DLGLIST
142 N NUMF,NUMR,OBJLIST,RIEN,ROUTINE,RTNLIST
143 N SERROR,SPONLIST,TEMLIST
144 S RIEN=$P(RTP,U,1)
145 ;
146 ;Get the list of definition findings and start the sponsor list.
147 D GETDFIND(RIEN,.FINDLIST)
148 ;
149 ;Add term findings to the list.
150 D GETTFIND(.FINDLIST)
151 ;
152 ;If a dialog exists for this reminder add it and its findings to the
153 ;list. Also collect any embedded TIU objects or templates
154 D DIALOG^PXRMEXDG(RIEN,.DLGLIST,.FINDLIST,.OBJLIST,.TEMLIST,.SPONLIST)
155 ;
156 ;If there were education topics make sure subtopics are included.
157 D SUB^PXRMEXED(.FINDLIST)
158 ;
159 ;The finding list is complete, search the definition, dialog and
160 ;all the findings for sponsors.
161 D BLDSPON(RIEN,.FINDLIST,.SPONLIST)
162 ;
163 ;Put sponsors first on the file list.
164 S NUMF=0
165 S IND0=0
166 F S IND0=$O(SPONLIST(IND0)) Q:IND0="" D
167 . S IEN=0
168 . F S IEN=$O(SPONLIST(IND0,IEN)) Q:IEN="" D
169 .. S NUMF=NUMF+1
170 .. S FILELIST(NUMF)="REMINDER SPONSOR"_U_811.6_U_IEN
171 ;
172 ;Look for any computed findings and put the associated routines
173 ;on the routine list.
174 S (IEN,NUMR)=0
175 F S IEN=$O(FINDLIST("REMINDER COMPUTED FINDINGS","F",IEN)) Q:IEN="" D
176 . S ROUTINE=$P(^PXRMD(811.4,IEN,0),U,2)
177 . S NUMR=NUMR+1
178 . S RTNLIST(NUMR)=ROUTINE
179 ;
180 ;Go through the finding list and create the file list in the same
181 ;order as the finding list.
182 S FILENAME=""
183 F S FILENAME=$O(FINDLIST(FILENAME)) Q:FILENAME="" D
184 . S FILENUM=FINDLIST(FILENAME)
185 . S IND0=""
186 . F S IND0=$O(FINDLIST(FILENAME,IND0)) Q:IND0="" D
187 .. S IEN=0
188 .. F S IEN=$O(FINDLIST(FILENAME,IND0,IEN)) Q:IEN="" D
189 ... S NUMF=NUMF+1
190 ... S FILELIST(NUMF)=FILENAME_U_FILENUM_U_IEN
191 ;
192 ;Add TIU templates to the file list.
193 S IND0=0
194 F S IND0=$O(TEMLIST(IND0)) Q:IND0="" D
195 . S IEN=$$EXISTS^PXRMEXIU(8927.1,TEMLIST(IND0))
196 . S NUMF=NUMF+1
197 . S FILELIST(NUMF)="TIU TEMPLATE FIELD"_U_8927.1_U_IEN
198 ;
199 ;Put the reminder at next to last.
200 S NUMF=NUMF+1
201 S FILELIST(NUMF)="REMINDER DEFINITION"_U_811.9_U_RIEN
202 ;
203 ;Put dialogs last on the file list.
204 S FILENUM=$G(DLGLIST("DIALOG"))
205 S IND0=""
206 F S IND0=$O(DLGLIST("DIALOG",IND0)) Q:IND0="" D
207 . S IEN=""
208 . F S IEN=$O(DLGLIST("DIALOG",IND0,IEN)) Q:IEN="" D
209 .. S NUMF=NUMF+1
210 .. S FILELIST(NUMF)="REMINDER DIALOG"_U_FILENUM_U_IEN
211 ;
212 S SERROR=0
213 ;Put any routines into the ^TMP array.
214 D GRTN^PXRMEXPU(.RTNLIST,NUMR,TMPIND,.SERROR)
215 ;Put the GETS^DIQ extracts of the findings, dialogs, and
216 ;reminder definition into the ^TMP array.
217 D GDIQF^PXRMEXPU(.FILELIST,NUMF,TMPIND,.SERROR)
218 ;
219 ;If there were any errors saving the data kill the ^TMP array.
220 I SERROR K ^TMP(TMPIND,$J)
221 Q
222 ;
223 ;===============================================================
224PUTSRC(RTP,TMPIND) ;Save the source information
225 N LOC
226 S LOC=$$SITE^VASITE
227 S ^TMP(TMPIND,$J,"SRC","REMINDER")=$P(RTP,U,2)
228 S ^TMP(TMPIND,$J,"SRC","USER")=$$GET1^DIQ(200,DUZ,.01)
229 S ^TMP(TMPIND,$J,"SRC","SITE")=$P(LOC,U,2)
230 S ^TMP(TMPIND,$J,"SRC","DATE")=$$FMTE^XLFDT($$NOW^XLFDT,"5Z")
231 Q
232 ;
Note: See TracBrowser for help on using the repository browser.