source: FOIAVistA/trunk/r/CLINICAL_CASE_REGISTRIES-ROR/RORRP016.m@ 1384

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

initial load of FOIAVistA 6/30/08 version
File size: 7.6 KB
Line 
1RORRP016 ;HCIOFO/SG - RPC: LIST OF ICD-9 CODES ; 6/16/06 2:16pm
2 ;;1.5;CLINICAL CASE REGISTRIES;**1**;Feb 17, 2006;Build 24
3 ;
4 ; This routine uses the following IAs:
5 ;
6 ; #3990 $$ICDDX^ICDCODE, $$ICDOP^ICDCODE, and
7 ; $$ICDD^ICDCODE (supported)
8 ; #10082 Access to the file #80 (supported)
9 ; #10083 Access to the file #80.1 (supported)
10 ;
11 Q
12 ;
13 ;***** RETURNS THE LIST OF ICD-9 CODES (DIAGNOSES OR PROCEDURES)
14 ; RPC: [ROR LIST ICD-9]
15 ;
16 ; .RORESULT Reference to a local variable where the results
17 ; are returned to.
18 ;
19 ; [DATE] Date for the code set versioning.
20 ;
21 ; [PART] The partial match restriction.
22 ;
23 ; [FLAGS] Flags that control the execution (can be combined):
24 ; A Exclude active codes
25 ; B Backwards. Traverses the index in the opposite
26 ; direction of normal traversal
27 ; D Full search by description
28 ; F Exclude codes applicable to females only
29 ; I Exclude inactive codes
30 ; K Search in description keywords
31 ; M Exclude codes applicable to males only
32 ; O Return operation/procedure codes from file #80.1
33 ; instead of diagnosis codes from the file #80
34 ; P Exclude codes that are not acceptable
35 ; as primary diagnoses
36 ;
37 ; [NUMBER] Maximum number of entries to return. A value of "*"
38 ; or no value in this parameter designates all entries.
39 ;
40 ; [FROM] The index entry(s) from which to begin the list
41 ; ^01: FromName
42 ; ^02: FromIEN
43 ;
44 ; For example, a FROM value of "51" would list entries
45 ; following 51. You can use the 2-nd and 3-rd "^"-
46 ; pieces of the @RORESULT@(0) node to continue the
47 ; listing in the subsequent procedure calls.
48 ;
49 ; NOTE: The FROM value itself is not included in
50 ; the resulting list.
51 ;
52 ; See description of the LIST^DIC for more details about the
53 ; PART, NUMBER and FROM parameters.
54 ;
55 ; The ^TMP("RORRP016",$J) global node is used by this procedure.
56 ;
57 ; Return Values:
58 ;
59 ; A negative value of the first "^"-piece of the @RORESULT@(0)
60 ; indicates an error (see the RPCSTK^RORERR procedure for more
61 ; details).
62 ;
63 ; Otherwise, number of ICD-9 codes and the value of the FROM
64 ; parameter for the next procedure call are returned in the
65 ; @RORESULT@(0) and the subsequent nodes of the global array
66 ; contain the codes.
67 ;
68 ; @RORESULT@(0) Result Descriptor
69 ; ^01: Number of codes
70 ; ^02: FromName
71 ; ^03: FromIEN
72 ;
73 ; @RORESULT@(i) ICD-9
74 ; ^01: IEN
75 ; ^02: Diagnosis or operation/procedure
76 ; ^03: Code
77 ; ^04: Use only with Sex
78 ; ^05: Inactive {0|1}
79 ; ^06: Inactivation Date (FileMan)
80 ;
81 ; @RORESULT@(i+1) ICD-9 Description
82 ;
83ICD9LIST(RORESULT,DATE,PART,FLAGS,NUMBER,FROM) ;
84 N BUF,RC,RORERRDL,TMP
85 D CLEAR^RORERR("ICD9LIST^RORRP016",1)
86 K RORESULT S RORESULT=$NA(^TMP("RORRP016",$J)) K @RORESULT
87 ;--- Check the parameters
88 S PART=$G(PART),FLAGS=$G(FLAGS)
89 S NUMBER=$S($G(NUMBER)>0:+NUMBER,1:"*")
90 ;--- Setup the start point
91 I $G(FROM)'="" D S FROM=$P(FROM,U)
92 . S:$P(FROM,U,2)>0 FROM("IEN")=+$P(FROM,U,2)
93 ;--- Compile the list
94 I FLAGS["O" D
95 . ;--- Get the list of operation/procedure codes
96 . S RC=$$QUERY1(PART,FLAGS,NUMBER,.FROM) Q:RC<0
97 . S RORESULT=$NA(@RORESULT@("DILIST"))
98 . ;--- Load remaining data and refine the list
99 . D REFINE1(PART,FLAGS,$G(DATE))
100 E D
101 . ;--- Get the list of diagnosis codes
102 . S RC=$$QUERY(PART,FLAGS,NUMBER,.FROM) Q:RC<0
103 . S RORESULT=$NA(@RORESULT@("DILIST"))
104 . ;--- Load remaining data and refine the list
105 . D REFINE(PART,FLAGS,$G(DATE))
106 I RC<0 D RPCSTK^RORERR(.RORESULT,RC) Q
107 ;--- Success
108 S TMP=$G(@RORESULT@(0)),BUF=+$P(TMP,U)
109 S:$P(TMP,U,3) $P(BUF,U,2,3)=$G(FROM)_U_$G(FROM("IEN"))
110 K @RORESULT@(0) S @RORESULT@(0)=BUF
111 Q
112 ;
113 ;***** QUERIES THE ICD DIAGNOSIS FILE (#80)
114QUERY(PART,FLAGS,NR,FROM) ;
115 N FLDS,RORMSG,SCR,TMP,XREF
116 ;--- Compile the screen logic (be careful with naked references)
117 S SCR=""
118 I FLAGS["D" S:PART'="" SCR=SCR_"I $P(D,U,3)["""_PART_""" ",PART=""
119 S:FLAGS["F" SCR=SCR_"I $P(D,U,10)'=""F"" "
120 S:FLAGS["M" SCR=SCR_"I $P(D,U,10)'=""M"" "
121 S:FLAGS["P" SCR=SCR_"I '$P(D,U,4) "
122 S:SCR'="" SCR="S D=$G(^(0)) "_SCR
123 ;--- Get the list of codes and some data
124 S FLDS="@;3;.01;9.5I;IXI",TMP="P"_$S(FLAGS["B":"B",1:"")
125 S XREF=$S(FLAGS["D":"#",FLAGS["K":"D",1:"BA")
126 D LIST^DIC(80,,FLDS,TMP,NR,.FROM,PART,XREF,SCR,,RORESULT,"RORMSG")
127 I $G(DIERR) K @RORESULT Q $$DBS^RORERR("RORMSG",-9,,,80)
128 ;--- Success
129 Q 0
130 ;
131 ;***** QUERIES THE ICD OPERATION/PROCEDURE FILE (#80.1)
132QUERY1(PART,FLAGS,NR,FROM) ;
133 N FLDS,RORMSG,SCR,TMP,XREF
134 ;--- Compile the screen logic (be careful with naked references)
135 S SCR=""
136 I FLAGS["D" S:PART'="" SCR=SCR_"I $P(D,U,4)["""_PART_""" ",PART=""
137 S:FLAGS["F" SCR=SCR_"I $P(D,U,10)'=""F"" "
138 S:FLAGS["M" SCR=SCR_"I $P(D,U,10)'=""M"" "
139 S:SCR'="" SCR="S D=$G(^(0)) "_SCR
140 ;--- Get the list of codes and some data
141 S FLDS="@;4;.01;9.5I;IXI",TMP="P"_$S(FLAGS["B":"B",1:"")
142 S XREF=$S(FLAGS["D":"#",FLAGS["K":"D",1:"BA")
143 D LIST^DIC(80.1,,FLDS,TMP,NR,.FROM,PART,XREF,SCR,,RORESULT,"RORMSG")
144 I $G(DIERR) K @RORESULT Q $$DBS^RORERR("RORMSG",-9,,,80.1)
145 ;--- Success
146 Q 0
147 ;
148 ;***** REFINES THE LIST OF DIAGNOSES
149REFINE(PART,FLAGS,DATE) ;
150 N BUF,CNT,ICDINFO,MODE,RORDESC,SUBS,TMP
151 S MODE=($TR(FLAGS,"DK")=FLAGS)
152 S (CNT,SUBS)=0
153 F S SUBS=$O(@RORESULT@(SUBS)) Q:SUBS'>0 D
154 . S BUF=@RORESULT@(SUBS,0)
155 . ;--- Remove duplicates created by the logic of the "BAA" xref
156 . I MODE D I '(TMP?1.E1" ") K @RORESULT@(SUBS) Q
157 . . S TMP=$P(BUF,U,5)
158 . ;--- Load the additional data
159 . S ICDINFO=$$ICDDX^ICDCODE(+$P(BUF,U),DATE)
160 . I ICDINFO<0 K @RORESULT@(SUBS) Q
161 . ;--- Screen active/inactive records
162 . S TMP=+$P(ICDINFO,U,10) ; Status
163 . I $S(TMP:FLAGS["A",1:FLAGS["I") K @RORESULT@(SUBS) Q
164 . S $P(BUF,U,5)=TMP
165 . S $P(BUF,U,6)=$S(TMP:$P(ICDINFO,U,12),1:"") ; Inactivation Date
166 . ;--- Versioned diagnosis
167 . S TMP=$P(ICDINFO,U,4) S:TMP'="" $P(BUF,U,2)=TMP
168 . ;--- Store the data
169 . S CNT=CNT+1,@RORESULT@(SUBS,0)=BUF
170 . ;--- Versioned description
171 . S TMP=$$ICDD^ICDCODE($P(BUF,U,3),"RORDESC")
172 . S @RORESULT@(SUBS,1)=$S($G(RORDESC(1))'="":RORDESC(1),1:$P(BUF,U,2))
173 . K RORDESC
174 ;---
175 S $P(@RORESULT@(0),U)=CNT
176 Q
177 ;
178 ;***** REFINES THE LIST OF OPERATION/PROCEDURES
179REFINE1(PART,FLAGS,DATE) ;
180 N BUF,CNT,ICDINFO,MODE,RORDESC,SUBS,TMP
181 S MODE=($TR(FLAGS,"DK")=FLAGS)
182 S (CNT,SUBS)=0
183 F S SUBS=$O(@RORESULT@(SUBS)) Q:SUBS'>0 D
184 . S BUF=@RORESULT@(SUBS,0)
185 . ;--- Remove duplicates created by the logic of the "BAA" xref
186 . I MODE D I '(TMP?1.E1" ") K @RORESULT@(SUBS) Q
187 . . S TMP=$P(BUF,U,5)
188 . ;--- Load the additional data
189 . S ICDINFO=$$ICDOP^ICDCODE(+$P(BUF,U),DATE)
190 . I ICDINFO<0 K @RORESULT@(SUBS) Q
191 . ;--- Screen active/inactive records
192 . S TMP=+$P(ICDINFO,U,10) ; Status
193 . I $S(TMP:FLAGS["A",1:FLAGS["I") K @RORESULT@(SUBS) Q
194 . S $P(BUF,U,5)=TMP
195 . S $P(BUF,U,6)=$S(TMP:$P(ICDINFO,U,12),1:"") ; Inactivation Date
196 . ;--- Versioned operation/procedure
197 . S TMP=$P(ICDINFO,U,5) S:TMP'="" $P(BUF,U,2)=TMP
198 . ;--- Store the data
199 . S CNT=CNT+1,@RORESULT@(SUBS,0)=BUF
200 . ;--- Versioned description
201 . S TMP=$$ICDD^ICDCODE($P(BUF,U,3),"RORDESC")
202 . S @RORESULT@(SUBS,1)=$S($G(RORDESC(1))'="":RORDESC(1),1:$P(BUF,U,2))
203 . K RORDESC
204 ;---
205 S $P(@RORESULT@(0),U)=CNT
206 Q
Note: See TracBrowser for help on using the repository browser.