source: FOIAVistA/tag/r/CLINICAL_CASE_REGISTRIES-ROR/RORXU002.m@ 628

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

initial load of FOIAVistA 6/30/08 version
File size: 7.8 KB
Line 
1RORXU002 ;HCIOFO/SG - REPORT BUILDER UTILITIES ; 5/18/06 11:13am
2 ;;1.5;CLINICAL CASE REGISTRIES;**1**;Feb 17, 2006;Build 24
3 ;
4 Q
5 ;
6 ;***** SCANS THE TABLE DEFINITION (RORSRC) FOR COLUMN NAMES
7 ;
8 ; .TERM Reference to a local variable where
9 ; is terminator is returned
10 ;
11 ; Return Values:
12 ; "" End of definition
13 ; ... Name of the column
14 ;
15COLSCAN(TERM) ;
16 N CH,I,TOKEN
17 F I=1:1 S TERM=$E(RORSRC,I) Q:"(,)"[TERM
18 S TOKEN=$E(RORSRC,1,I-1)
19 F I=I+1:1 S CH=$E(RORSRC,I) Q:(CH="")!("(,)"'[CH)
20 S $E(RORSRC,1,I-1)=""
21 Q TOKEN
22 ;
23 ;***** CHECKS THE FILEMAN DATE/TIME VALUE
24DATE(DT) ;
25 Q $S(DT>0:+DT,1:"")
26 ;
27 ;***** OUTPUTS THE BASIC HEADER TO THE REPORT
28 ;
29 ; .RORTSK Task number and task parameters
30 ;
31 ; PARTAG Reference (IEN) to the parent tag
32 ;
33 ; Return Values:
34 ; <0 Error code
35 ; >0 IEN of the HEADER element
36 ;
37HEADER(RORTSK,PARTAG) ;
38 N HEADER,IENS,REGIEN,RORBUF,RORMSG,TMP
39 S HEADER=$$ADDVAL^RORTSK11(RORTSK,"HEADER",,PARTAG)
40 Q:HEADER<0 HEADER
41 D ADDVAL^RORTSK11(RORTSK,"DATE",$$DATE($$NOW^XLFDT),HEADER)
42 D ADDVAL^RORTSK11(RORTSK,"TASK_NUMBER",RORTSK,HEADER)
43 S REGIEN=+$$PARAM^RORTSK01("REGIEN")
44 ;---
45 S IENS=REGIEN_","
46 D GETS^DIQ(798.1,IENS,"1;2","I","RORBUF","RORMSG")
47 Q:$G(DIERR) $$DBS^RORERR("RORMSG",-9,,,798.1,IENS)
48 S TMP=$G(RORBUF(798.1,IENS,1,"I"))
49 D ADDVAL^RORTSK11(RORTSK,"UPDATED_UNTIL",$$DATE(TMP),HEADER)
50 S TMP=$G(RORBUF(798.1,IENS,2,"I"))
51 D ADDVAL^RORTSK11(RORTSK,"EXTRACTED_UNTIL",$$DATE(TMP),HEADER)
52 Q HEADER
53 ;
54 ;***** PARSES THE COMMA-SEPARATED LIST
55 ;
56 ; .LIST Reference to a local variable that contains a list.
57 ; Items of the list are returned as the subscripts of
58 ; this variable.
59 ;
60LIST(LIST) ;
61 N I,TMP,VAL
62 F I=1:1 S VAL=$P(LIST,",",I) Q:VAL="" D
63 . S TMP=$$TRIM^XLFSTR(VAL)
64 . S:TMP'="" LIST(TMP)=""
65 Q
66 ;
67 ;***** COMPILES A TEXT DESCRIPTION FOR THE REPORT OPTIONS
68 ;
69 ; .OPTIONS Reference to a local variable containing
70 ; the options as subscripts
71 ;
72 ; [DLGNUM] Number of the dialog that contains the template
73 ; (7980000.018, by default).
74 ;
75 ; Return Values:
76 ; ... Text description of the options
77 ;
78OPTXT(OPTIONS,DLGNUM) ;
79 N I,J,NS,RORBUF,TEXT,TMP
80 S:$G(DLGNUM)'>0 DLGNUM=7980000.018
81 D BLD^DIALOG(DLGNUM,,,"RORBUF")
82 S TEXT="",I=0
83 F S I=$O(RORBUF(I)) Q:I="" D:$E(RORBUF(I),1)'=" "
84 . S NS=0
85 . F J=1:1 S TMP=$TR($P(RORBUF(I),",",J)," ") Q:TMP="" D
86 . . S:$D(OPTIONS(TMP)) NS=2**(J-1)+NS
87 . Q:'NS
88 . S TMP=$$TRIM^XLFSTR($G(RORBUF(I+NS)))
89 . S:TMP'="" TEXT=TEXT_", "_TMP
90 Q $P(TEXT,", ",2,999)
91 ;
92 ;***** OUTPUTS THE PARAMETERS TO THE REPORT
93 ;
94 ; .RORTSK Task number and task parameters
95 ;
96 ; PARTAG Reference (IEN) to the parent tag
97 ;
98 ; .STDT Start and end dates of the report
99 ; .ENDT are returned via these parameters
100 ;
101 ; [.FLAGS] Flags for the $$SKIP^RORXU005 are returned via this
102 ; parameter. The "D" (skip deceased patients) and "G"
103 ; (skip pending patients) flags are always added.
104 ;
105 ; Return Values:
106 ; <0 Error code
107 ; >0 IEN of the PARAMETERS element
108 ;
109PARAMS(RORTSK,PARTAG,STDT,ENDT,FLAGS) ;
110 N BUF,ELEMENT,I,LTAG,MODE,NAME,PARAMS,RC,REGIEN,RORMSG,TMP
111 S PARAMS=$$ADDVAL^RORTSK11(RORTSK,"PARAMETERS",,PARTAG)
112 S RC=0,(ENDT,STDT)="",FLAGS=""
113 ;
114 ;=== Registry name
115 S REGIEN=+$$PARAM^RORTSK01("REGIEN")
116 I REGIEN>0 D Q:RC<0 RC
117 . S TMP=$P($$REGNAME^RORUTL01(REGIEN),U)
118 . I TMP="" S RC=-1 Q
119 . S RC=$$ADDVAL^RORTSK11(RORTSK,"REGNAME",TMP,PARAMS)
120 ;
121 ;=== Alternate date ranges
122 F I=2:1:3 D Q:RC<0
123 . S STDT=$$PARAM^RORTSK01("DATE_RANGE_"_I,"START")\1 Q:STDT'>0
124 . S ENDT=$$PARAM^RORTSK01("DATE_RANGE_"_I,"END")\1 Q:ENDT'>0
125 . S ELEMENT=$$ADDVAL^RORTSK11(RORTSK,"DATE_RANGE_"_I,,PARAMS)
126 . I ELEMENT<0 S RC=+ELEMENT Q
127 . S RC=$$ADDATTR^RORTSK11(RORTSK,ELEMENT,"START",STDT) Q:RC<0
128 . S RC=$$ADDATTR^RORTSK11(RORTSK,ELEMENT,"END",ENDT)
129 Q:RC<0 RC
130 ;
131 ;=== Main date range
132 S STDT=$$PARAM^RORTSK01("DATE_RANGE","START")\1
133 S ENDT=$$PARAM^RORTSK01("DATE_RANGE","END")\1
134 I STDT>0,ENDT>0 D Q:RC<0 RC
135 . S ELEMENT=$$ADDVAL^RORTSK11(RORTSK,"DATE_RANGE",,PARAMS)
136 . I ELEMENT<0 S RC=+ELEMENT Q
137 . S RC=$$ADDATTR^RORTSK11(RORTSK,ELEMENT,"START",STDT) Q:RC<0
138 . S RC=$$ADDATTR^RORTSK11(RORTSK,ELEMENT,"END",ENDT)
139 E S (ENDT,STDT)=""
140 ;
141 ;=== Task comment
142 S TMP=$$PARAM^RORTSK01("TASK_COMMENT")
143 D:TMP'="" ADDVAL^RORTSK11(RORTSK,"TASK_COMMENT",TMP,PARAMS)
144 ;
145 ;=== Patient selection and Options
146 F NAME="PATIENTS","OPTIONS" D Q:RC<0
147 . K BUF M BUF=RORTSK("PARAMS",NAME,"A") Q:$D(BUF)<10
148 . ;--- Generate the XML tags
149 . S ELEMENT=$$ADDVAL^RORTSK11(RORTSK,NAME,$$OPTXT(.BUF),PARAMS)
150 . I ELEMENT'>0 S RC=ELEMENT Q
151 . S TMP=""
152 . F S TMP=$O(BUF(TMP)) Q:TMP="" D Q:RC<0
153 . . S RC=$$ADDATTR^RORTSK11(RORTSK,ELEMENT,TMP,"1")
154 . ;--- Compile the flags
155 . D:NAME="PATIENTS"
156 . . S:'$D(BUF("DE_BEFORE")) FLAGS=FLAGS_"P"
157 . . S:'$D(BUF("DE_DURING")) FLAGS=FLAGS_"N"
158 . . S:'$D(BUF("DE_AFTER")) FLAGS=FLAGS_"F"
159 Q:RC<0 RC
160 ;
161 ;=== Other Registries
162 I $D(RORTSK("PARAMS","OTHER_REGISTRIES","C"))>1 D Q:RC<0 RC
163 . N NODE,REGIEN
164 . S LTAG=$$ADDVAL^RORTSK11(RORTSK,"OTHER_REGISTRIES",,PARAMS)
165 . I LTAG<0 S RC=+LTAG Q
166 . S NODE=$NA(RORTSK("PARAMS","OTHER_REGISTRIES","C"))
167 . S REGIEN=0
168 . F S REGIEN=$O(@NODE@(REGIEN)) Q:REGIEN'>0 D Q:RC<0
169 . . S TMP=$P($$REGNAME^RORUTL01(REGIEN),U,2)
170 . . S MODE=+$G(@NODE@(REGIEN))
171 . . I 'MODE!(TMP="") K @NODE@(REGIEN) Q
172 . . S TMP=TMP_" ("_$S(MODE<0:"Exclude",1:"Include")_")"
173 . . S RC=$$ADDVAL^RORTSK11(RORTSK,"REGNAME",TMP,LTAG)
174 . S FLAGS=FLAGS_"R"
175 ;
176 ;=== Local Fields
177 I $D(RORTSK("PARAMS","LOCAL_FIELDS","C"))>1 D Q:RC<0 RC
178 . N NODE,IEN,IENS
179 . S LTAG=$$ADDVAL^RORTSK11(RORTSK,"LOCAL_FIELDS",,PARAMS)
180 . I LTAG<0 S RC=+LTAG Q
181 . S NODE=$NA(RORTSK("PARAMS","LOCAL_FIELDS","C"))
182 . S IEN=0
183 . F S IEN=$O(@NODE@(IEN)) Q:IEN'>0 D Q:RC<0
184 . . S TMP=$$GET1^DIQ(799.53,IEN_",",.01,,,"RORMSG")
185 . . D:$G(DIERR) DBS^RORERR("RORMSG",-9,,,799.53,IEN_",")
186 . . S MODE=+$G(@NODE@(IEN))
187 . . I 'MODE!(TMP="") K @NODE@(IEN) Q
188 . . S TMP=TMP_" ("_$S(MODE<0:"Exclude",1:"Include")_")"
189 . . S RC=$$ADDVAL^RORTSK11(RORTSK,"FIELD",TMP,LTAG)
190 . S FLAGS=FLAGS_"O"
191 ;
192 ;=== Lab test ranges
193 I $D(RORTSK("PARAMS","LRGRANGES","C"))>1 D Q:RC<0 RC
194 . N GRC,NODE
195 . S NODE=$NA(RORTSK("PARAMS","LRGRANGES","C"))
196 . S GRC=0
197 . F S GRC=$O(@NODE@(GRC)) Q:GRC'>0 D Q:RC<0
198 . . S RC=$$ITEMIEN^RORUTL09(3,REGIEN,GRC,.TMP)
199 . . S:RC'<0 @NODE@(GRC)=TMP
200 ;
201 ;=== Defaults
202 S TMP=$TR(FLAGS,"FNP") S:$L(FLAGS)-$L(TMP)=3 FLAGS=TMP
203 S FLAGS=FLAGS_"DG"
204 ;
205 ;=== Success
206 Q PARAMS
207 ;
208 ;***** GENERATES TABLE DEFINITION
209 ;
210 ; TBLREF Reference to the definition table in the source
211 ; code (TAG^ROUTINE). See the HEADER^RORX013 for
212 ; examples of table definitions.
213 ;
214 ; HEADER IEN of the HEADER element
215 ;
216 ; Return Values:
217 ; <0 Error code
218 ; 0 Ok
219 ;
220TBLDEF(TBLREF,HEADER) ;
221 N COND,IT,NAME,RC,RORSRC,TBLDEF,TERM,TGET
222 S TGET="S RORSRC=$T("_$P(TBLREF,"^")_"+IT^"_$P(TBLREF,"^",2)_")"
223 S RC=0
224 F IT=1:1 X TGET S RORSRC=$P(RORSRC,";;",2) Q:RORSRC="" D Q:RC<0
225 . S COND=$$TRIM^XLFSTR($P(RORSRC,U,2,999))
226 . I COND'="" X COND E Q
227 . S RORSRC=$$TRIM^XLFSTR($P(RORSRC,U))
228 . S NAME=$$COLSCAN(.TERM) Q:(NAME="")!(TERM'="(")
229 . S TBLDEF=$$ADDVAL^RORTSK11(RORTSK,"TBLDEF",,HEADER)
230 . I TBLDEF<0 S RC=TBLDEF Q
231 . D ADDATTR^RORTSK11(RORTSK,TBLDEF,"NAME",NAME)
232 . D ADDATTR^RORTSK11(RORTSK,TBLDEF,"HEADER","1")
233 . D ADDATTR^RORTSK11(RORTSK,TBLDEF,"FOOTER","1")
234 . D TBLDEF1(TBLDEF)
235 Q $S(RC<0:RC,1:0)
236 ;
237 ;***** GENERATES <COLUMN> ELEMENTS FROM TABLE DEFINITION (RORSRC)
238 ;
239 ; PTAG IEN of the parent element
240 ;
241TBLDEF1(PTAG) ;
242 N COLUMN,NAME,TERM
243 F S NAME=$$COLSCAN(.TERM) Q:NAME="" D Q:")"[TERM
244 . S COLUMN=$$ADDVAL^RORTSK11(RORTSK,"COLUMN",,PTAG)
245 . D ADDATTR^RORTSK11(RORTSK,COLUMN,"NAME",NAME)
246 . D:TERM="(" TBLDEF1(COLUMN)
247 Q
Note: See TracBrowser for help on using the repository browser.