VAFHLZCD ;ALB/KCL,Zoltan,JAN,TDM,TEJ,LMD - Create HL7 Catastrophic Disability (ZCD) segment ; 9/19/05 11:31am
;;5.3;Registration;**122,232,387,653,894**;Aug 13, 1993;Build 48
;
;
; This generic extrinsic function is designed to return the
; HL7 Catastrophic Disability (ZCD) segment. This segment
; contains VA-specific catastrophic disability information
; for a patient.
;
EN(DFN,VAFSTR,VAFNUM,VAFHLQ,VAFHLFS) ; --
; Entry point for creating HL7 Catastrophic Disability (ZCD) segment.
;
; Input(s):
; DFN - internal entry number of Patient (#2) file
; VAFSTR - (optional) string of fields requested, separated by
; commas. If not passed, return all data fields.
; VAFNUM - (optional) sequential number for SET ID (default=1)
; VAFHLQ - (optional) HL7 null variable
; VAFHLFS - (optional) HL7 field separator
;
; Performance Note:
; VAFCDLST - Optional array (created by MAKELST subroutine below.)
; In cases involving multiple ZCD segments, performance
; is enhanced by calling MAKELST to create this array
; before invoking this function. This may not apply
; in cases where BUILD is invoked to create multiple
; ZCD segments.
;
; Other optional input variables:
; HLQ - HL7 default value to use when a sequence is empty.
; HLFS - HL7 default primary delimiter (between sequences.)
;
; Output(s):
; String containing the desired components of the HL7 ZCD segment
;
; NOTE:
; In cases where multiple diagnoses, procedures, and/or conditions
; exist to support a status of CATASTROPHICALLY DISABLED, the
; MAKELST subroutine (see below) is invoked to serialize them
; (along with any related information) into separate ZCD
; segments. This function will return the text of a single
; ZCD segment based on the segment number in VAFNUM.
;
N VAFCAT,VAFY,X,SETID,VALOK,SUB
;
; if VAFHLQ or VAFHLFS not passed, use default HL7 variables
I $D(VAFHLQ)[0 S VAFHLQ=$G(HLQ)
I $G(VAFHLFS)="" S VAFHLFS=$G(HLFS,"^")
;
; if set id not passed, use default
S VAFNUM=$S($G(VAFNUM):VAFNUM,1:1)
;
; if DFN not passed, exit
I '$G(DFN) S VAFY=1 G ENQ
;
; get catastrophic disability info for a patient into VAFCAT
I '$$GET^DGENCDA(DFN,.VAFCAT) S VAFY=1 G ENQ
; If sequence 13="Y" or "N", then sequences 2 through 6 are required.
; If sequence 13="" then sequences 2 through 6 should not be sent.
S VALOK=1
I VAFCAT("VCD")'="" F SUB="REVDTE","BY","FACDET","DATE","METDET" I $G(VAFCAT(SUB))="" S VALOK=0
I 'VALOK F SUB="REVDTE","BY","FACDET","DATE","METDET","VCD" S VAFCAT(SUB)=""
;
; if VAFSTR not passed, return all data fields
I $G(VAFSTR)="" S VAFSTR="1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17" ;DG*5.3*894
;
; initialize output string and requested data fields
S $P(VAFY,VAFHLFS,$L(VAFSTR,","))=""
S VAFSTR=","_VAFSTR_","
;
; Create a list to restrict multiple-valued fields to separate
; segments. For example, if there are any DIAG, PROC and COND
; entries, then no two of those values (or their associated sub-
; fields) may occupy the same ZCD segment. (See MAKELST below
; for implementation details.)
I '$D(VAFCDLST) N VAFCDLST D MAKELST(.VAFCDLST,.VAFCAT)
;
; set-up segment data fields
; 1 - Set ID
S SETID=$S($G(VAFNUM):VAFNUM,1:1)
S $P(VAFY,VAFHLFS,1)=SETID
; 2 - Review Date
I VAFSTR[",2," S $P(VAFY,VAFHLFS,2)=$S(VAFCAT("REVDTE")'="":$$HLDATE^HLFNC(VAFCAT("REVDTE")),1:VAFHLQ)
; 3 - Decided By
I VAFSTR[",3," S $P(VAFY,VAFHLFS,3)=$S(VAFCAT("BY")'="":VAFCAT("BY"),1:VAFHLQ)
; 4 - Facility Making Determination
I VAFSTR[",4," S X=$$STATION^VAFHLFNC(VAFCAT("FACDET")) S $P(VAFY,VAFHLFS,4)=$S(X'="":X,1:VAFHLQ)
; 5 - Date of Decision
I VAFSTR[",5," S $P(VAFY,VAFHLFS,5)=$S(VAFCAT("DATE")'="":$$HLDATE^HLFNC(VAFCAT("DATE")),1:VAFHLQ)
; 6 - Method of Determination
I VAFSTR[",6," S $P(VAFY,VAFHLFS,6)=$S(VAFCAT("METDET")'="":$$METH2HL7^DGENA5(VAFCAT("METDET")),1:VAFHLQ)
; 17 - Catastrophic Disability Descriptor(s) - DG*5.3*894
K VANO S VANO=1 I VAFSTR[",17,",$D(VAFCAT("DESCR"))>0 S $P(VAFY,VAFHLFS,17)=$$DSCR2HL7^DGENA5(DFN) S:$P(VAFY,VAFHLFS,17)]"" VANO=0
; 7 - Diagnosis (multiple), DG*5.3*894
I VANO,VAFSTR[",7," S $P(VAFY,VAFHLFS,7)=$S($G(VAFCDLST(SETID,"DIAG"))'="":$$RSNTOHL7^DGENA5(VAFCDLST(SETID,"DIAG")),1:VAFHLQ)
; 8 - Procedure (multiple), DG*5.3*894
I VANO,VAFSTR[",8," S $P(VAFY,VAFHLFS,8)=$S($G(VAFCDLST(SETID,"PROC"))'="":$$RSNTOHL7^DGENA5(VAFCDLST(SETID,"PROC")),1:VAFHLQ)
; 9 - Affected Extremity (Procedure sub-field)
I VAFSTR[",9," S $P(VAFY,VAFHLFS,9)=$S($G(VAFCDLST(SETID,"EXT"))'="":$$LIMBTOHL^DGENA5(VAFCDLST(SETID,"EXT")),1:VAFHLQ)
; 10 - Condition (multiple), DG*5.3*894
I VANO,VAFSTR[",10," S $P(VAFY,VAFHLFS,10)=$S($G(VAFCDLST(SETID,"COND"))'="":$$RSNTOHL7^DGENA5(VAFCDLST(SETID,"COND")),1:VAFHLQ)
; 11 - Score (Condition sub-field)
I VAFSTR[",11," S $P(VAFY,VAFHLFS,11)=$S($G(VAFCDLST(SETID,"SCORE"))'="":VAFCDLST(SETID,"SCORE"),1:VAFHLQ)
; 12 - Veteran Catastrophically Disabled?
I VAFSTR[",12," S $P(VAFY,VAFHLFS,12)=$S(VAFCAT("VCD")'="":VAFCAT("VCD"),1:VAFHLQ)
; 13 - Permanent Indicator (Condition sub-field)
I VAFSTR[",13," S $P(VAFY,VAFHLFS,13)=$S($G(VAFCDLST(SETID,"PERM"))'="":$$PERMTOHL^DGENA5(VAFCDLST(SETID,"PERM")),1:VAFHLQ)
; 14 - Date Veteran Requested CD Evaluation
I VAFSTR[",14," S $P(VAFY,VAFHLFS,14)=$S(VAFCAT("VETREQDT")'="":$$HLDATE^HLFNC(VAFCAT("VETREQDT")),1:VAFHLQ)
; 15 - Date Facility Initiated Review
I VAFSTR[",15," S $P(VAFY,VAFHLFS,15)=$S(VAFCAT("DTFACIRV")'="":$$HLDATE^HLFNC(VAFCAT("DTFACIRV")),1:VAFHLQ)
; 16 - Date Veteran Was Notified
I VAFSTR[",16," S $P(VAFY,VAFHLFS,16)=$S(VAFCAT("DTVETNOT")'="":$$HLDATE^HLFNC(VAFCAT("DTVETNOT")),1:VAFHLQ)
;
S:$E(VAFSTR,1)="," VAFSTR=$E(VAFSTR,2,$L(VAFSTR))
S:$E(VAFSTR,$L(VAFSTR))="," VAFSTR=$E(VAFSTR,1,$L(VAFSTR)-1)
ENQ Q "ZCD"_VAFHLFS_$G(VAFY)
;
; Subroutines follow...
MAKELST(VAFCDLST,VAFCAT) ; Make list of ZCD Segments.
; Inputs:
; VAFCDLST - By reference (used to hold output array.)
; VAFCAT - By reference, an array containing the patient's CD
; data (as created in $$GET^DGENCDA).
; Output:
; VAFCDLST(Segment#,"DIAG") = CD Diagnosis (pointer to #27.17).
; VAFCDLST(Segment#,"PROC")= CD Procedure(pointer to #27.17).
; VAFCDLST(Segment#,"EXT") = Affected Extremity (for procedure).
; VAFCDLST(Segment#,"COND")= CD Condition (pointer to #27.17).
; VAFCDLST(Segment#,"PERM") = Permanent Indicator (for condition).
; VAFCDLST(Segment#,"SCORE") = Test Score (for condition).
; VAFCDLST(Segment#,"DESCR") = CD Descriptor(for VCD="yes") * DG*5.3*894
;
; Per Enrollment Phase II SRS (Section 4.2.4) no ZCD segment should
; contain more than one CD Reason (Diagnosis, Procedure, Condition.)
; So this procedure adds each one as a separate ZCD segment.
;
N ITEM,SITEM,STR
K VAFCDLST
S VAFCDLST=0
S (ITEM,SITEM)=""
; Add each Diagnosis as a separate ZCD segment.
F S ITEM=$O(VAFCAT("DIAG",ITEM)) Q:ITEM="" D
. D ADDNEW(.VAFCDLST,"DIAG",VAFCAT("DIAG",ITEM))
; Add each Procedure as a separate ZCD segment.
F S ITEM=$O(VAFCAT("PROC",ITEM)) Q:ITEM="" D
. F S SITEM=$O(VAFCAT("EXT",ITEM,SITEM)) Q:SITEM="" D
.. D ADDNEW(.VAFCDLST,"PROC",VAFCAT("PROC",ITEM))
.. D INSERT(.VAFCDLST,"EXT",VAFCAT("EXT",ITEM,SITEM))
; Add each Condition as a separate ZCD segment.
F S ITEM=$O(VAFCAT("COND",ITEM)) Q:ITEM="" D
. D ADDNEW(.VAFCDLST,"COND",VAFCAT("COND",ITEM))
. D INSERT(.VAFCDLST,"SCORE",VAFCAT("SCORE",ITEM))
. D INSERT(.VAFCDLST,"PERM",VAFCAT("PERM",ITEM))
I VAFCDLST=0 S VAFCDLST=1 ; At least one ZCD segment.
Q
ADDNEW(LIST,NAME,ITEM) ; Add an item to the list (internal use only).
; Inputs:
; LIST - By reference, a list of items.
; NAME - Name of one item to add.
; ITEM - Value of item to add.
; Note: a new position is created in the list.
S LIST=LIST+1
S LIST(LIST,NAME)=ITEM
Q
INSERT(LIST,NAME,ITEM) ; Insert item into existing list position (internal).
; LIST - By reference, a list of items.
; NAME - Name of one item to add.
; ITEM - Value of item to add.
; Note: the list should already contain at least one item.
S LIST(LIST,NAME)=ITEM
Q
BUILD(VAFSEGS,DFN,VAFSTR,VAFHLQ,VAFHLFS) ;
; Entry point for creating HL7 Catastrophic Disability (ZCD) segments.
; This is the preferred entry point for building ZCD segments.
;
; Input(s):
; VAFSEGS - Pass-by-reference array to contain all ZCD segments
; for this patient.
; DFN - internal entry number of Patient (#2) file
; VAFSTR - (optional) string of fields requested, separated by
; commas. If not passed, return all data fields.
; VAFHLQ - (optional) HL7 null variable
; VAFHLFS - (optional) HL7 field separator
;
; Output:
; VAFSEGS - By reference, an array containing all ZCD segments.
; Format: VAFSEGS = Number of ZCD Segments
; VAFSEGS(1) = First ZCD Segment
; VAFSEGS(2) = Second ZCD Segment (if any)...
; etc.
;
; NOTE:
; Per Enrollment Phase II SRS (Section 4.2.4) no ZCD segment should
; contain more than one CD Reason (Diagnosis, Procedure, Condition.)
; As a result, multiple ZCD segments will be created if more than
; one of these fields has a value. The MAKELST procedure contains
; logic to enforce this requirement.
;
N VAFCDLST ; Temporary array of CD REASON info.
K VAFSEGS S VAFSEGS=0 ; Initialize array.
; DFN is required.
I '$G(DFN) Q
; get catastrophic disability info for a patient into VAFCAT
I '$$GET^DGENCDA(DFN,.VAFCAT) Q
; Create a list VAFCDLST to enforce one CD REASON per segment.
D MAKELST(.VAFCDLST,.VAFCAT)
I 'VAFCDLST Q
; Create an array of HL7 segments.
F VAFSEGS=1:1:VAFCDLST S VAFSEGS(VAFSEGS)=$$EN(DFN,.VAFSTR,VAFSEGS,.VAFHLQ,.VAFHLFS)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HVAFHLZCD 10070 printed Apr 09, 2024@21:39:49 Page 2
VAFHLZCD ;ALB/KCL,Zoltan,JAN,TDM,TEJ,LMD - Create HL7 Catastrophic Disability (ZCD) segment ; 9/19/05 11:31am
+1 ;;5.3;Registration;**122,232,387,653,894**;Aug 13, 1993;Build 48
+2 ;
+3 ;
+4 ; This generic extrinsic function is designed to return the
+5 ; HL7 Catastrophic Disability (ZCD) segment. This segment
+6 ; contains VA-specific catastrophic disability information
+7 ; for a patient.
+8 ;
EN(DFN,VAFSTR,VAFNUM,VAFHLQ,VAFHLFS) ; --
+1 ; Entry point for creating HL7 Catastrophic Disability (ZCD) segment.
+2 ;
+3 ; Input(s):
+4 ; DFN - internal entry number of Patient (#2) file
+5 ; VAFSTR - (optional) string of fields requested, separated by
+6 ; commas. If not passed, return all data fields.
+7 ; VAFNUM - (optional) sequential number for SET ID (default=1)
+8 ; VAFHLQ - (optional) HL7 null variable
+9 ; VAFHLFS - (optional) HL7 field separator
+10 ;
+11 ; Performance Note:
+12 ; VAFCDLST - Optional array (created by MAKELST subroutine below.)
+13 ; In cases involving multiple ZCD segments, performance
+14 ; is enhanced by calling MAKELST to create this array
+15 ; before invoking this function. This may not apply
+16 ; in cases where BUILD is invoked to create multiple
+17 ; ZCD segments.
+18 ;
+19 ; Other optional input variables:
+20 ; HLQ - HL7 default value to use when a sequence is empty.
+21 ; HLFS - HL7 default primary delimiter (between sequences.)
+22 ;
+23 ; Output(s):
+24 ; String containing the desired components of the HL7 ZCD segment
+25 ;
+26 ; NOTE:
+27 ; In cases where multiple diagnoses, procedures, and/or conditions
+28 ; exist to support a status of CATASTROPHICALLY DISABLED, the
+29 ; MAKELST subroutine (see below) is invoked to serialize them
+30 ; (along with any related information) into separate ZCD
+31 ; segments. This function will return the text of a single
+32 ; ZCD segment based on the segment number in VAFNUM.
+33 ;
+34 NEW VAFCAT,VAFY,X,SETID,VALOK,SUB
+35 ;
+36 ; if VAFHLQ or VAFHLFS not passed, use default HL7 variables
+37 IF $DATA(VAFHLQ)[0
SET VAFHLQ=$GET(HLQ)
+38 IF $GET(VAFHLFS)=""
SET VAFHLFS=$GET(HLFS,"^")
+39 ;
+40 ; if set id not passed, use default
+41 SET VAFNUM=$SELECT($GET(VAFNUM):VAFNUM,1:1)
+42 ;
+43 ; if DFN not passed, exit
+44 IF '$GET(DFN)
SET VAFY=1
GOTO ENQ
+45 ;
+46 ; get catastrophic disability info for a patient into VAFCAT
+47 IF '$$GET^DGENCDA(DFN,.VAFCAT)
SET VAFY=1
GOTO ENQ
+48 ; If sequence 13="Y" or "N", then sequences 2 through 6 are required.
+49 ; If sequence 13="" then sequences 2 through 6 should not be sent.
+50 SET VALOK=1
+51 IF VAFCAT("VCD")'=""
FOR SUB="REVDTE","BY","FACDET","DATE","METDET"
IF $GET(VAFCAT(SUB))=""
SET VALOK=0
+52 IF 'VALOK
FOR SUB="REVDTE","BY","FACDET","DATE","METDET","VCD"
SET VAFCAT(SUB)=""
+53 ;
+54 ; if VAFSTR not passed, return all data fields
+55 ;DG*5.3*894
IF $GET(VAFSTR)=""
SET VAFSTR="1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17"
+56 ;
+57 ; initialize output string and requested data fields
+58 SET $PIECE(VAFY,VAFHLFS,$LENGTH(VAFSTR,","))=""
+59 SET VAFSTR=","_VAFSTR_","
+60 ;
+61 ; Create a list to restrict multiple-valued fields to separate
+62 ; segments. For example, if there are any DIAG, PROC and COND
+63 ; entries, then no two of those values (or their associated sub-
+64 ; fields) may occupy the same ZCD segment. (See MAKELST below
+65 ; for implementation details.)
+66 IF '$DATA(VAFCDLST)
NEW VAFCDLST
DO MAKELST(.VAFCDLST,.VAFCAT)
+67 ;
+68 ; set-up segment data fields
+69 ; 1 - Set ID
+70 SET SETID=$SELECT($GET(VAFNUM):VAFNUM,1:1)
+71 SET $PIECE(VAFY,VAFHLFS,1)=SETID
+72 ; 2 - Review Date
+73 IF VAFSTR[",2,"
SET $PIECE(VAFY,VAFHLFS,2)=$SELECT(VAFCAT("REVDTE")'="":$$HLDATE^HLFNC(VAFCAT("REVDTE")),1:VAFHLQ)
+74 ; 3 - Decided By
+75 IF VAFSTR[",3,"
SET $PIECE(VAFY,VAFHLFS,3)=$SELECT(VAFCAT("BY")'="":VAFCAT("BY"),1:VAFHLQ)
+76 ; 4 - Facility Making Determination
+77 IF VAFSTR[",4,"
SET X=$$STATION^VAFHLFNC(VAFCAT("FACDET"))
SET $PIECE(VAFY,VAFHLFS,4)=$SELECT(X'="":X,1:VAFHLQ)
+78 ; 5 - Date of Decision
+79 IF VAFSTR[",5,"
SET $PIECE(VAFY,VAFHLFS,5)=$SELECT(VAFCAT("DATE")'="":$$HLDATE^HLFNC(VAFCAT("DATE")),1:VAFHLQ)
+80 ; 6 - Method of Determination
+81 IF VAFSTR[",6,"
SET $PIECE(VAFY,VAFHLFS,6)=$SELECT(VAFCAT("METDET")'="":$$METH2HL7^DGENA5(VAFCAT("METDET")),1:VAFHLQ)
+82 ; 17 - Catastrophic Disability Descriptor(s) - DG*5.3*894
+83 KILL VANO
SET VANO=1
IF VAFSTR[",17,"
IF $DATA(VAFCAT("DESCR"))>0
SET $PIECE(VAFY,VAFHLFS,17)=$$DSCR2HL7^DGENA5(DFN)
if $PIECE(VAFY,VAFHLFS,17)]""
SET VANO=0
+84 ; 7 - Diagnosis (multiple), DG*5.3*894
+85 IF VANO
IF VAFSTR[",7,"
SET $PIECE(VAFY,VAFHLFS,7)=$SELECT($GET(VAFCDLST(SETID,"DIAG"))'="":$$RSNTOHL7^DGENA5(VAFCDLST(SETID,"DIAG")),1:VAFHLQ)
+86 ; 8 - Procedure (multiple), DG*5.3*894
+87 IF VANO
IF VAFSTR[",8,"
SET $PIECE(VAFY,VAFHLFS,8)=$SELECT($GET(VAFCDLST(SETID,"PROC"))'="":$$RSNTOHL7^DGENA5(VAFCDLST(SETID,"PROC")),1:VAFHLQ)
+88 ; 9 - Affected Extremity (Procedure sub-field)
+89 IF VAFSTR[",9,"
SET $PIECE(VAFY,VAFHLFS,9)=$SELECT($GET(VAFCDLST(SETID,"EXT"))'="":$$LIMBTOHL^DGENA5(VAFCDLST(SETID,"EXT")),1:VAFHLQ)
+90 ; 10 - Condition (multiple), DG*5.3*894
+91 IF VANO
IF VAFSTR[",10,"
SET $PIECE(VAFY,VAFHLFS,10)=$SELECT($GET(VAFCDLST(SETID,"COND"))'="":$$RSNTOHL7^DGENA5(VAFCDLST(SETID,"COND")),1:VAFHLQ)
+92 ; 11 - Score (Condition sub-field)
+93 IF VAFSTR[",11,"
SET $PIECE(VAFY,VAFHLFS,11)=$SELECT($GET(VAFCDLST(SETID,"SCORE"))'="":VAFCDLST(SETID,"SCORE"),1:VAFHLQ)
+94 ; 12 - Veteran Catastrophically Disabled?
+95 IF VAFSTR[",12,"
SET $PIECE(VAFY,VAFHLFS,12)=$SELECT(VAFCAT("VCD")'="":VAFCAT("VCD"),1:VAFHLQ)
+96 ; 13 - Permanent Indicator (Condition sub-field)
+97 IF VAFSTR[",13,"
SET $PIECE(VAFY,VAFHLFS,13)=$SELECT($GET(VAFCDLST(SETID,"PERM"))'="":$$PERMTOHL^DGENA5(VAFCDLST(SETID,"PERM")),1:VAFHLQ)
+98 ; 14 - Date Veteran Requested CD Evaluation
+99 IF VAFSTR[",14,"
SET $PIECE(VAFY,VAFHLFS,14)=$SELECT(VAFCAT("VETREQDT")'="":$$HLDATE^HLFNC(VAFCAT("VETREQDT")),1:VAFHLQ)
+100 ; 15 - Date Facility Initiated Review
+101 IF VAFSTR[",15,"
SET $PIECE(VAFY,VAFHLFS,15)=$SELECT(VAFCAT("DTFACIRV")'="":$$HLDATE^HLFNC(VAFCAT("DTFACIRV")),1:VAFHLQ)
+102 ; 16 - Date Veteran Was Notified
+103 IF VAFSTR[",16,"
SET $PIECE(VAFY,VAFHLFS,16)=$SELECT(VAFCAT("DTVETNOT")'="":$$HLDATE^HLFNC(VAFCAT("DTVETNOT")),1:VAFHLQ)
+104 ;
+105 if $EXTRACT(VAFSTR,1)=","
SET VAFSTR=$EXTRACT(VAFSTR,2,$LENGTH(VAFSTR))
+106 if $EXTRACT(VAFSTR,$LENGTH(VAFSTR))=","
SET VAFSTR=$EXTRACT(VAFSTR,1,$LENGTH(VAFSTR)-1)
ENQ QUIT "ZCD"_VAFHLFS_$GET(VAFY)
+1 ;
+2 ; Subroutines follow...
MAKELST(VAFCDLST,VAFCAT) ; Make list of ZCD Segments.
+1 ; Inputs:
+2 ; VAFCDLST - By reference (used to hold output array.)
+3 ; VAFCAT - By reference, an array containing the patient's CD
+4 ; data (as created in $$GET^DGENCDA).
+5 ; Output:
+6 ; VAFCDLST(Segment#,"DIAG") = CD Diagnosis (pointer to #27.17).
+7 ; VAFCDLST(Segment#,"PROC")= CD Procedure(pointer to #27.17).
+8 ; VAFCDLST(Segment#,"EXT") = Affected Extremity (for procedure).
+9 ; VAFCDLST(Segment#,"COND")= CD Condition (pointer to #27.17).
+10 ; VAFCDLST(Segment#,"PERM") = Permanent Indicator (for condition).
+11 ; VAFCDLST(Segment#,"SCORE") = Test Score (for condition).
+12 ; VAFCDLST(Segment#,"DESCR") = CD Descriptor(for VCD="yes") * DG*5.3*894
+13 ;
+14 ; Per Enrollment Phase II SRS (Section 4.2.4) no ZCD segment should
+15 ; contain more than one CD Reason (Diagnosis, Procedure, Condition.)
+16 ; So this procedure adds each one as a separate ZCD segment.
+17 ;
+18 NEW ITEM,SITEM,STR
+19 KILL VAFCDLST
+20 SET VAFCDLST=0
+21 SET (ITEM,SITEM)=""
+22 ; Add each Diagnosis as a separate ZCD segment.
+23 FOR
SET ITEM=$ORDER(VAFCAT("DIAG",ITEM))
if ITEM=""
QUIT
Begin DoDot:1
+24 DO ADDNEW(.VAFCDLST,"DIAG",VAFCAT("DIAG",ITEM))
End DoDot:1
+25 ; Add each Procedure as a separate ZCD segment.
+26 FOR
SET ITEM=$ORDER(VAFCAT("PROC",ITEM))
if ITEM=""
QUIT
Begin DoDot:1
+27 FOR
SET SITEM=$ORDER(VAFCAT("EXT",ITEM,SITEM))
if SITEM=""
QUIT
Begin DoDot:2
+28 DO ADDNEW(.VAFCDLST,"PROC",VAFCAT("PROC",ITEM))
+29 DO INSERT(.VAFCDLST,"EXT",VAFCAT("EXT",ITEM,SITEM))
End DoDot:2
End DoDot:1
+30 ; Add each Condition as a separate ZCD segment.
+31 FOR
SET ITEM=$ORDER(VAFCAT("COND",ITEM))
if ITEM=""
QUIT
Begin DoDot:1
+32 DO ADDNEW(.VAFCDLST,"COND",VAFCAT("COND",ITEM))
+33 DO INSERT(.VAFCDLST,"SCORE",VAFCAT("SCORE",ITEM))
+34 DO INSERT(.VAFCDLST,"PERM",VAFCAT("PERM",ITEM))
End DoDot:1
+35 ; At least one ZCD segment.
IF VAFCDLST=0
SET VAFCDLST=1
+36 QUIT
ADDNEW(LIST,NAME,ITEM) ; Add an item to the list (internal use only).
+1 ; Inputs:
+2 ; LIST - By reference, a list of items.
+3 ; NAME - Name of one item to add.
+4 ; ITEM - Value of item to add.
+5 ; Note: a new position is created in the list.
+6 SET LIST=LIST+1
+7 SET LIST(LIST,NAME)=ITEM
+8 QUIT
INSERT(LIST,NAME,ITEM) ; Insert item into existing list position (internal).
+1 ; LIST - By reference, a list of items.
+2 ; NAME - Name of one item to add.
+3 ; ITEM - Value of item to add.
+4 ; Note: the list should already contain at least one item.
+5 SET LIST(LIST,NAME)=ITEM
+6 QUIT
BUILD(VAFSEGS,DFN,VAFSTR,VAFHLQ,VAFHLFS) ;
+1 ; Entry point for creating HL7 Catastrophic Disability (ZCD) segments.
+2 ; This is the preferred entry point for building ZCD segments.
+3 ;
+4 ; Input(s):
+5 ; VAFSEGS - Pass-by-reference array to contain all ZCD segments
+6 ; for this patient.
+7 ; DFN - internal entry number of Patient (#2) file
+8 ; VAFSTR - (optional) string of fields requested, separated by
+9 ; commas. If not passed, return all data fields.
+10 ; VAFHLQ - (optional) HL7 null variable
+11 ; VAFHLFS - (optional) HL7 field separator
+12 ;
+13 ; Output:
+14 ; VAFSEGS - By reference, an array containing all ZCD segments.
+15 ; Format: VAFSEGS = Number of ZCD Segments
+16 ; VAFSEGS(1) = First ZCD Segment
+17 ; VAFSEGS(2) = Second ZCD Segment (if any)...
+18 ; etc.
+19 ;
+20 ; NOTE:
+21 ; Per Enrollment Phase II SRS (Section 4.2.4) no ZCD segment should
+22 ; contain more than one CD Reason (Diagnosis, Procedure, Condition.)
+23 ; As a result, multiple ZCD segments will be created if more than
+24 ; one of these fields has a value. The MAKELST procedure contains
+25 ; logic to enforce this requirement.
+26 ;
+27 ; Temporary array of CD REASON info.
NEW VAFCDLST
+28 ; Initialize array.
KILL VAFSEGS
SET VAFSEGS=0
+29 ; DFN is required.
+30 IF '$GET(DFN)
QUIT
+31 ; get catastrophic disability info for a patient into VAFCAT
+32 IF '$$GET^DGENCDA(DFN,.VAFCAT)
QUIT
+33 ; Create a list VAFCDLST to enforce one CD REASON per segment.
+34 DO MAKELST(.VAFCDLST,.VAFCAT)
+35 IF 'VAFCDLST
QUIT
+36 ; Create an array of HL7 segments.
+37 FOR VAFSEGS=1:1:VAFCDLST
SET VAFSEGS(VAFSEGS)=$$EN(DFN,.VAFSTR,VAFSEGS,.VAFHLQ,.VAFHLFS)
+38 QUIT
