source: FOIAVistA/trunk/r/REGISTRATION-DGQE-DG-DPT-GRPX-VAD-VAF-VAS-VAT-VAU--VA-VIC--DGBT--DGJ--DGYA--VALM/VAFHLZCD.m@ 635

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

initial load of FOIAVistA 6/30/08 version
File size: 9.3 KB
Line 
1VAFHLZCD ;ALB/KCL,Zoltan,JAN,TDM - Create HL7 Catastrophic Disability (ZCD) segment ; 9/19/05 11:31am
2 ;;5.3;Registration;**122,232,387,653**;Aug 13, 1993;Build 2
3 ;
4 ;
5 ; This generic extrinsic function is designed to return the
6 ; HL7 Catastrophic Disability (ZCD) segment. This segment
7 ; contains VA-specific catastrophic disability information
8 ; for a patient.
9 ;
10EN(DFN,VAFSTR,VAFNUM,VAFHLQ,VAFHLFS) ; --
11 ; Entry point for creating HL7 Catastrophic Disability (ZCD) segment.
12 ;
13 ; Input(s):
14 ; DFN - internal entry number of Patient (#2) file
15 ; VAFSTR - (optional) string of fields requested, separated by
16 ; commas. If not passed, return all data fields.
17 ; VAFNUM - (optional) sequential number for SET ID (default=1)
18 ; VAFHLQ - (optional) HL7 null variable
19 ; VAFHLFS - (optional) HL7 field separator
20 ;
21 ; Performance Note:
22 ; VAFCDLST - Optional array (created by MAKELST subroutine below.)
23 ; In cases involving multiple ZCD segments, performance
24 ; is enhanced by calling MAKELST to create this array
25 ; before invoking this function. This may not apply
26 ; in cases where BUILD is invoked to create multiple
27 ; ZCD segments.
28 ;
29 ; Other optional input variables:
30 ; HLQ - HL7 default value to use when a sequence is empty.
31 ; HLFS - HL7 default primary delimiter (between sequences.)
32 ;
33 ; Output(s):
34 ; String containing the desired components of the HL7 ZCD segment
35 ;
36 ; NOTE:
37 ; In cases where multiple diagnoses, procedures, and/or conditions
38 ; exist to support a status of CATASTROPHICALLY DISABLED, the
39 ; MAKELST subroutine (see below) is invoked to serialize them
40 ; (along with any related information) into separate ZCD
41 ; segments. This function will return the text of a single
42 ; ZCD segment based on the segment number in VAFNUM.
43 ;
44 N VAFCAT,VAFY,X,SETID,VALOK,SUB
45 ;
46 ; if VAFHLQ or VAFHLFS not passed, use default HL7 variables
47 I $D(VAFHLQ)[0 S VAFHLQ=$G(HLQ)
48 I $G(VAFHLFS)="" S VAFHLFS=$G(HLFS,"^")
49 ;
50 ; if set id not passed, use default
51 S VAFNUM=$S($G(VAFNUM):VAFNUM,1:1)
52 ;
53 ; if DFN not passed, exit
54 I '$G(DFN) S VAFY=1 G ENQ
55 ;
56 ; get catastrophic disability info for a patient into VAFCAT
57 I '$$GET^DGENCDA(DFN,.VAFCAT) S VAFY=1 G ENQ
58 ; If sequence 13="Y" or "N", then sequences 2 through 6 are required.
59 ; If sequence 13="" then sequences 2 through 6 should not be sent.
60 S VALOK=1
61 I VAFCAT("VCD")'="" F SUB="REVDTE","BY","FACDET","DATE","METDET" I $G(VAFCAT(SUB))="" S VALOK=0
62 I 'VALOK F SUB="REVDTE","BY","FACDET","DATE","METDET","VCD" S VAFCAT(SUB)=""
63 ;
64 ; if VAFSTR not passed, return all data fields
65 I $G(VAFSTR)="" S VAFSTR="1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16"
66 ;
67 ; initialize output string and requested data fields
68 S $P(VAFY,VAFHLFS,$L(VAFSTR,","))=""
69 S VAFSTR=","_VAFSTR_","
70 ;
71 ; Create a list to restrict multiple-valued fields to separate
72 ; segments. For example, if there are any DIAG, PROC and COND
73 ; entries, then no two of those values (or their associated sub-
74 ; fields) may occupy the same ZCD segment. (See MAKELST below
75 ; for implementation details.)
76 I '$D(VAFCDLST) N VAFCDLST D MAKELST(.VAFCDLST,.VAFCAT)
77 ;
78 ; set-up segment data fields
79 ; 1 - Set ID
80 S SETID=$S($G(VAFNUM):VAFNUM,1:1)
81 S $P(VAFY,VAFHLFS,1)=SETID
82 ; 2 - Review Date
83 I VAFSTR[",2," S $P(VAFY,VAFHLFS,2)=$S(VAFCAT("REVDTE")'="":$$HLDATE^HLFNC(VAFCAT("REVDTE")),1:VAFHLQ)
84 ; 3 - Decided By
85 I VAFSTR[",3," S $P(VAFY,VAFHLFS,3)=$S(VAFCAT("BY")'="":VAFCAT("BY"),1:VAFHLQ)
86 ; 4 - Facility Making Determination
87 I VAFSTR[",4," S X=$$STATION^VAFHLFNC(VAFCAT("FACDET")) S $P(VAFY,VAFHLFS,4)=$S(X'="":X,1:VAFHLQ)
88 ; 5 - Date of Decision
89 I VAFSTR[",5," S $P(VAFY,VAFHLFS,5)=$S(VAFCAT("DATE")'="":$$HLDATE^HLFNC(VAFCAT("DATE")),1:VAFHLQ)
90 ; 6 - Method of Determination
91 I VAFSTR[",6," S $P(VAFY,VAFHLFS,6)=$S(VAFCAT("METDET")'="":$$METH2HL7^DGENA5(VAFCAT("METDET")),1:VAFHLQ)
92 ; 7 - Diagnosis (multiple)
93 I VAFSTR[",7," S $P(VAFY,VAFHLFS,7)=$S($G(VAFCDLST(SETID,"DIAG"))'="":$$RSNTOHL7^DGENA5(VAFCDLST(SETID,"DIAG")),1:VAFHLQ)
94 ; 8 - Procedure (multiple)
95 I VAFSTR[",8," S $P(VAFY,VAFHLFS,8)=$S($G(VAFCDLST(SETID,"PROC"))'="":$$RSNTOHL7^DGENA5(VAFCDLST(SETID,"PROC")),1:VAFHLQ)
96 ; 9 - Affected Extremity (Procedure sub-field)
97 I VAFSTR[",9," S $P(VAFY,VAFHLFS,9)=$S($G(VAFCDLST(SETID,"EXT"))'="":$$LIMBTOHL^DGENA5(VAFCDLST(SETID,"EXT")),1:VAFHLQ)
98 ; 10 - Condition (multiple)
99 I VAFSTR[",10," S $P(VAFY,VAFHLFS,10)=$S($G(VAFCDLST(SETID,"COND"))'="":$$RSNTOHL7^DGENA5(VAFCDLST(SETID,"COND")),1:VAFHLQ)
100 ; 11 - Score (Condition sub-field)
101 I VAFSTR[",11," S $P(VAFY,VAFHLFS,11)=$S($G(VAFCDLST(SETID,"SCORE"))'="":VAFCDLST(SETID,"SCORE"),1:VAFHLQ)
102 ; 12 - Veteran Catastrophically Disabled?
103 I VAFSTR[",12," S $P(VAFY,VAFHLFS,12)=$S(VAFCAT("VCD")'="":VAFCAT("VCD"),1:VAFHLQ)
104 ; 13 - Permanent Indicator (Condition sub-field)
105 I VAFSTR[",13," S $P(VAFY,VAFHLFS,13)=$S($G(VAFCDLST(SETID,"PERM"))'="":$$PERMTOHL^DGENA5(VAFCDLST(SETID,"PERM")),1:VAFHLQ)
106 ; 14 - Date Veteran Requested CD Evaluation
107 I VAFSTR[",14," S $P(VAFY,VAFHLFS,14)=$S(VAFCAT("VETREQDT")'="":$$HLDATE^HLFNC(VAFCAT("VETREQDT")),1:VAFHLQ)
108 ; 15 - Date Facility Initiated Review
109 I VAFSTR[",15," S $P(VAFY,VAFHLFS,15)=$S(VAFCAT("DTFACIRV")'="":$$HLDATE^HLFNC(VAFCAT("DTFACIRV")),1:VAFHLQ)
110 ; 16 - Date Veteran Was Notified
111 I VAFSTR[",16," S $P(VAFY,VAFHLFS,16)=$S(VAFCAT("DTVETNOT")'="":$$HLDATE^HLFNC(VAFCAT("DTVETNOT")),1:VAFHLQ)
112 ;
113 S:$E(VAFSTR,1)="," VAFSTR=$E(VAFSTR,2,$L(VAFSTR))
114 S:$E(VAFSTR,$L(VAFSTR))="," VAFSTR=$E(VAFSTR,1,$L(VAFSTR)-1)
115ENQ Q "ZCD"_VAFHLFS_$G(VAFY)
116 ;
117 ; Subroutines follow...
118MAKELST(VAFCDLST,VAFCAT) ; Make list of ZCD Segments.
119 ; Inputs:
120 ; VAFCDLST - By reference (used to hold output array.)
121 ; VAFCAT - By reference, an array containing the patient's CD
122 ; data (as created in $$GET^DGENCDA).
123 ; Output:
124 ; VAFCDLST(Segment#,"DIAG") = CD Diagnosis (pointer to #27.17).
125 ; VAFCDLST(Segment#,"PROC")= CD Procedure(pointer to #27.17).
126 ; VAFCDLST(Segment#,"EXT") = Affected Extremity (for procedure).
127 ; VAFCDLST(Segment#,"COND")= CD Condition (pointer to #27.17).
128 ; VAFCDLST(Segment#,"PERM") = Permanent Indicator (for condition).
129 ; VAFCDLST(Segment#,"SCORE") = Test Score (for condition).
130 ;
131 ; Per Enrollment Phase II SRS (Section 4.2.4) no ZCD segment should
132 ; contain more than one CD Reason (Diagnosis, Procedure, Condition.)
133 ; So this procedure adds each one as a separate ZCD segment.
134 ;
135 N ITEM,SITEM,STR
136 K VAFCDLST
137 S VAFCDLST=0
138 S (ITEM,SITEM)=""
139 ; Add each Diagnosis as a separate ZCD segment.
140 F S ITEM=$O(VAFCAT("DIAG",ITEM)) Q:ITEM="" D
141 . D ADDNEW(.VAFCDLST,"DIAG",VAFCAT("DIAG",ITEM))
142 ; Add each Procedure as a separate ZCD segment.
143 F S ITEM=$O(VAFCAT("PROC",ITEM)) Q:ITEM="" D
144 . F S SITEM=$O(VAFCAT("EXT",ITEM,SITEM)) Q:SITEM="" D
145 .. D ADDNEW(.VAFCDLST,"PROC",VAFCAT("PROC",ITEM))
146 .. D INSERT(.VAFCDLST,"EXT",VAFCAT("EXT",ITEM,SITEM))
147 ; Add each Condition as a separate ZCD segment.
148 F S ITEM=$O(VAFCAT("COND",ITEM)) Q:ITEM="" D
149 . D ADDNEW(.VAFCDLST,"COND",VAFCAT("COND",ITEM))
150 . D INSERT(.VAFCDLST,"SCORE",VAFCAT("SCORE",ITEM))
151 . D INSERT(.VAFCDLST,"PERM",VAFCAT("PERM",ITEM))
152 I VAFCDLST=0 S VAFCDLST=1 ; At least one ZCD segment.
153 Q
154ADDNEW(LIST,NAME,ITEM) ; Add an item to the list (internal use only).
155 ; Inputs:
156 ; LIST - By reference, a list of items.
157 ; NAME - Name of one item to add.
158 ; ITEM - Value of item to add.
159 ; Note: a new position is created in the list.
160 S LIST=LIST+1
161 S LIST(LIST,NAME)=ITEM
162 Q
163INSERT(LIST,NAME,ITEM) ; Insert item into existing list position (internal).
164 ; LIST - By reference, a list of items.
165 ; NAME - Name of one item to add.
166 ; ITEM - Value of item to add.
167 ; Note: the list should already contain at least one item.
168 S LIST(LIST,NAME)=ITEM
169 Q
170BUILD(VAFSEGS,DFN,VAFSTR,VAFHLQ,VAFHLFS) ;
171 ; Entry point for creating HL7 Catastrophic Disability (ZCD) segments.
172 ; This is the preferred entry point for building ZCD segments.
173 ;
174 ; Input(s):
175 ; VAFSEGS - Pass-by-reference array to contain all ZCD segments
176 ; for this patient.
177 ; DFN - internal entry number of Patient (#2) file
178 ; VAFSTR - (optional) string of fields requested, separated by
179 ; commas. If not passed, return all data fields.
180 ; VAFHLQ - (optional) HL7 null variable
181 ; VAFHLFS - (optional) HL7 field separator
182 ;
183 ; Output:
184 ; VAFSEGS - By reference, an array containing all ZCD segments.
185 ; Format: VAFSEGS = Number of ZCD Segments
186 ; VAFSEGS(1) = First ZCD Segment
187 ; VAFSEGS(2) = Second ZCD Segment (if any)...
188 ; etc.
189 ;
190 ; NOTE:
191 ; Per Enrollment Phase II SRS (Section 4.2.4) no ZCD segment should
192 ; contain more than one CD Reason (Diagnosis, Procedure, Condition.)
193 ; As a result, multiple ZCD segments will be created if more than
194 ; one of these fields has a value. The MAKELST procedure contains
195 ; logic to enforce this requirement.
196 ;
197 N VAFCDLST ; Temporary array of CD REASON info.
198 K VAFSEGS S VAFSEGS=0 ; Initialize array.
199 ; DFN is required.
200 I '$G(DFN) Q
201 ; get catastrophic disability info for a patient into VAFCAT
202 I '$$GET^DGENCDA(DFN,.VAFCAT) Q
203 ; Create a list VAFCDLST to enforce one CD REASON per segment.
204 D MAKELST(.VAFCDLST,.VAFCAT)
205 I 'VAFCDLST Q
206 ; Create an array of HL7 segments.
207 F VAFSEGS=1:1:VAFCDLST S VAFSEGS(VAFSEGS)=$$EN(DFN,.VAFSTR,VAFSEGS,.VAFHLQ,.VAFHLFS)
208 Q
Note: See TracBrowser for help on using the repository browser.