source: FOIAVistA/trunk/r/CLINICAL_CASE_REGISTRIES-ROR/RORTSK13.m@ 1397

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

initial load of FOIAVistA 6/30/08 version
File size: 7.0 KB
Line 
1RORTSK13 ;HCIOFO/SG - PARSER FOR REPORT PARAMETERS ; 6/23/06 1:45pm
2 ;;1.5;CLINICAL CASE REGISTRIES;**1**;Feb 17, 2006;Build 24
3 ;
4 ; This routine uses the following IAs:
5 ;
6 ; #1995 $$CODEN^ICPTCOD (supported)
7 ; #3990 $$CODEN^ICDCODE (supported)
8 ; #4543 IEN^PSN50P65 (supported)
9 ;
10 ; RORXML -------------- DESCRIPTOR FOR THE XML PARSING
11 ;
12 ; RORXML(
13 ;
14 ; "ERR") Number of parsing errors
15 ;
16 ; "PATH") Path to the current XML tag
17 ;
18 ; "RXGRP") Name of the current drug group
19 ;
20 ; "TI") Number of the current text line of
21 ; the current tag value
22 ;
23 Q
24 ;
25 ;***** START DOCUMENT CALLBACK FOR THE SAX PARSER
26DOCSTART ;
27 S RORXML("PATH")="",RORXML("ERR")=0
28 K RORXML("RXGRP")
29 Q
30 ;
31 ;***** DUMMY CALLBACKS FOR THE SAX PARSER
32DUMMY(DUMMY1,DUMMY2,DUMMY3) ;
33DUMMY1 Q
34 ;
35 ;***** END ELEMENT CALLBACK FOR THE SAX PARSER
36 ;
37 ; ELMT Name of the element
38 ;
39ELEND(ELMT) ;
40 ;--- Reset the drug group name in the end of the group
41 K:RORXML("PATH")="PARAMS,DRUGS,GROUP" RORXML("RXGRP")
42 ;--- Reset the ICD-9 group name in the end of the group
43 K:RORXML("PATH")="PARAMS,ICD9LST,GROUP" RORXML("ICD9GRP")
44 ;--- Update the current element path
45 S RORXML("PATH")=$P(RORXML("PATH"),",",1,$L(RORXML("PATH"),",")-1)
46 Q
47 ;
48 ;***** START DOCUMENT CALLBACK FOR THE SAX PARSER
49 ;
50 ; ELMT Name of the element
51 ; .ATTR List of attributes and their values
52 ;
53ELSTART(ELMT,ATTR) ;
54 N GROUP,ID,IEN,ITEM,LIST,LVL,RC,SECTION,TMP
55 ;--- Update the current element path
56 S RORXML("PATH")=RORXML("PATH")_$S(RORXML("PATH")'="":",",1:"")_ELMT
57 S RORXML("TI")=1
58 ;--- Ignore everything except parameters
59 Q:$P(RORXML("PATH"),",")'="PARAMS"
60 S LVL=$L(RORXML("PATH"),",")
61 ;
62 ;=== Store 3-level lists
63 I LVL=5 D Q
64 . S LIST=$P(RORXML("PATH"),",",LVL-3,LVL-1)
65 . ;--- Medications and drug classes
66 . I $P(LIST,",",1,2)="DRUGS,GROUP" D Q
67 . . S GROUP=$G(RORXML("RXGRP")) Q:GROUP=""
68 . . S SECTION=$P(LIST,",",3) Q:SECTION=""
69 . . S ID=$G(ATTR("ID")) Q:ID=""
70 . . S RORTSK("PARAMS","DRUGS","G",GROUP,SECTION,ID)=$G(ATTR("CODE"))
71 ;
72 ;=== Store 2-level lists
73 I LVL=4 D Q
74 . S LIST=$P(RORXML("PATH"),",",LVL-2,LVL-1)
75 . ;--- ICD-9 codes
76 . I LIST="ICD9LST,GROUP" D Q
77 . . S GROUP=$G(RORXML("ICD9GRP")) Q:GROUP=""
78 . . S ID=$G(ATTR("ID")) Q:ID=""
79 . . S TMP=$S($G(RORTSK("PARAMS","ICD9LST","A","PROCMODE")):80.1,1:80)
80 . . S IEN=+$$CODEN^ICDCODE(ID,TMP)
81 . . S:IEN>0 RORTSK("PARAMS","ICD9LST","G",GROUP,"C",IEN)=ID
82 ;
83 ;=== Store the lists
84 I LVL=3 D Q
85 . S LIST=$P(RORXML("PATH"),",",LVL-1)
86 . ;--- List of ICD-9 codes
87 . I LIST="CPTLST" D:ELMT="CPT" Q
88 . . S ID=$G(ATTR("ID")) Q:ID=""
89 . . S IEN=+$$CODEN^ICPTCOD(ID)
90 . . S:IEN>0 RORTSK("PARAMS",LIST,"C",IEN)=ID
91 . ;--- Name of the current drug group and its attributes
92 . I LIST="DRUGS" D:ELMT="GROUP" Q
93 . . S (RORXML("RXGRP"),ID)=$G(ATTR("ID")) Q:ID=""
94 . . M RORTSK("PARAMS","DRUGS","G",ID,"A")=ATTR
95 . . K RORTSK("PARAMS","DRUGS","G",ID,"A","ID")
96 . ;--- Name of the current ICD-9 group
97 . I LIST="ICD9LST" D:ELMT="GROUP" Q
98 . . S RORXML("ICD9GRP")=$G(ATTR("ID"))
99 . ;--- List of ICD-9 codes
100 . ;I LIST="ICD9LST" D:ELMT="ICD9" Q
101 . ;. S ID=$G(ATTR("ID")) Q:ID=""
102 . ;. S TMP=$S($G(RORTSK("PARAMS","ICD9LST","A","PROC")):80.1,1:80)
103 . ;. S IEN=+$$CODEN^ICDCODE(ID,TMP)
104 . ;. S:IEN>0 RORTSK("PARAMS",LIST,"C",IEN)=ID
105 . ;--- Lab tests
106 . I LIST="LABTESTS" D:ELMT="LT" Q
107 . . S ID=$G(ATTR("ID")) Q:ID=""
108 . . S RORTSK("PARAMS","LABTESTS","C",ID)=""
109 . . S TMP=$G(ATTR("LOW"))
110 . . S:TMP'="" RORTSK("PARAMS","LABTESTS","C",ID,"L")=TMP
111 . . S TMP=$G(ATTR("HIGH"))
112 . . S:TMP'="" RORTSK("PARAMS","LABTESTS","C",ID,"H")=TMP
113 . ;--- Laboratory test ranges
114 . I LIST="LRGRANGES" D:ELMT="LRGRANGE" Q
115 . . S ID=$G(ATTR("ID")) Q:'$G(ATTR("USE"))!(ID="")
116 . . S RORTSK("PARAMS",LIST,"C",ID)=""
117 . . S TMP=$G(ATTR("LOW"))
118 . . S:TMP'="" RORTSK("PARAMS",LIST,"C",ID,"L")=TMP
119 . . S TMP=$G(ATTR("HIGH"))
120 . . S:TMP'="" RORTSK("PARAMS",LIST,"C",ID,"H")=TMP
121 . ;--- "Include/Exclude" list processing
122 . I (LIST="LOCAL_FIELDS")!(LIST="OTHER_REGISTRIES") D Q
123 . . S ID=$G(ATTR("ID")) Q:ID=""
124 . . S TMP=+$G(ATTR("MODE")) ; 1 - Include; -1 - Exclude
125 . . S:TMP RORTSK("PARAMS",LIST,"C",ID)=TMP
126 . ;--- Default processing
127 . S TMP=","_LIST_","
128 . Q:'(",CLINICS,DIVISIONS,OPTIONAL_COLUMNS,PATIENTS,SELRULES,UTIL_TYPES,"[TMP)
129 . S ID=$G(ATTR("ID"))
130 . S:ID'="" RORTSK("PARAMS",LIST,"C",ID)=""
131 ;
132 ;=== Store the top-level attributes
133 I LVL=2 D Q
134 . ;--- Date range(s)
135 . I ELMT?1"DATE_RANGE".1(1"_"1.N) D Q
136 . . N STDT,ENDT
137 . . S RC=$$DTRANGE^RORTSK14(.ATTR,.STDT,.ENDT) Q:RC<0
138 . . S RORTSK("PARAMS",ELMT,"A","START")=STDT
139 . . S RORTSK("PARAMS",ELMT,"A","END")=ENDT
140 . ;--- Ignore internal nodes
141 . Q:ELMT="PANELS"
142 . ;--- Default processing
143 . M RORTSK("PARAMS",ELMT,"A")=ATTR
144 ;
145 ;--- Ignore everything else
146 Q
147 ;
148 ;***** TEXT CALLBACK FOR THE SAX PARSER
149 ;
150 ; TXT Line of unmarked text
151 ;
152ELTEXT(TXT) ;
153 N ITEM,LIST,LVL
154 S LVL=$L(RORXML("PATH"),",")
155 ;--- Store top-level values
156 I LVL=2 D Q
157 . S ITEM=$P(RORXML("PATH"),",",LVL)
158 . S RORTSK("PARAMS",ITEM)=$G(RORTSK("PARAMS",ITEM))_TXT
159 ;--- Ignore everything else
160 Q
161 ;
162 ;***** ERROR CALLBACK FOR THE SAX PARSER
163 ;
164 ; .ERR Reference to a local variable containing
165 ; informations about the error
166 ;
167ERROR(ERR) ;
168 N ERRCODE,RORINFO,TMP
169 I ERR("SEV") D
170 . S ERRCODE=-105,RORXML("ERR")=$G(RORXML("ERR"))+1
171 E S ERRCODE=-104
172 ;--- Prepare message details
173 S RORINFO(1)=$TR(ERR("MSG"),U,"~")
174 S TMP=$P("Warning^Validation Error^Conformance Error",U,ERR("SEV")+1)
175 S RORINFO(2)=TMP_" in line #"_ERR("LIN")_" (pos#"_ERR("POS")_")"
176 S RORINFO(3)=$TR(ERR("XML"),$C(9,10,13)," ")
177 ;--- Record the error message
178 D ERROR^RORERR(ERRCODE,,.RORINFO)
179 Q
180 ;
181 ;***** PARSES AND PREPARES THE REPORT PARAMETERS
182 ;
183 ; .PARAMS Reference to a local variable that contains report
184 ; parameters in XML format. This variable is KILL'ed
185 ; by this function.
186 ;
187 ; .RORTSK Reference to a local variable that contains a task
188 ; descriptor.
189 ;
190 ; Return Values:
191 ; <0 Error code
192 ; 0 Ok
193 ;
194PARSEPRM(PARAMS,RORTSK) ;
195 K RORTSK("PARAMS")
196 Q:$D(PARAMS)<10 0
197 ;---
198 N CBK,RORSRC,RORSUBS,RORTMP,RORXML
199 S RORSRC=$$ALLOC^RORTMP() ; Source buffer for XML
200 S RORTMP=$$ALLOC^RORTMP(.RORSUBS) ; Temporary buffer
201 ;--- Copy the XML document into a global since the parser
202 ;--- cannot read it from a local variable
203 M @RORSRC=PARAMS K PARAMS
204 ;--- Parse the parameters
205 S CBK("CHARACTERS")="ELTEXT^RORTSK13"
206 S CBK("COMMENT")="DUMMY^RORTSK13"
207 S CBK("DOCTYPE")="DUMMY^RORTSK13"
208 S CBK("ENDDOCUMENT")="DUMMY1^RORTSK13"
209 S CBK("ENDELEMENT")="ELEND^RORTSK13"
210 S CBK("ERROR")="ERROR^RORTSK13"
211 S CBK("EXTERNAL")="DUMMY^RORTSK13"
212 S CBK("NOTATION")="DUMMY^RORTSK13"
213 S CBK("PI")="DUMMY^RORTSK13"
214 S CBK("STARTDOCUMENT")="DOCSTART^RORTSK13"
215 S CBK("STARTELEMENT")="ELSTART^RORTSK13"
216 D EN^MXMLPRSE(RORSRC,.CBK,"W")
217 ;--- Cleanup
218 D FREE^RORTMP(RORTMP),FREE^RORTMP(RORSRC)
219 Q $S($G(RORXML("ERR"))>0:$$ERROR^RORERR(-106),1:0)
Note: See TracBrowser for help on using the repository browser.