VAFHLZRD ;ALB/KCL,PJH - CREATE HL7 RATED DISABILITIES (ZRD) SEGMENTS ; 5/31/07 2:59pm
;;5.3;Registration;**122,144,754**;Aug 13,1993;Build 46
;
;
; This generic function creates HL7 VA-Specific Rated Disabilities
; (ZRD) segments for a patient.
;
EN(DFN,VAFSTR,VAFHLQ,VAFHLFS,VAFARRY) ;--
; Entry point to return HL7 Rated Disabilities (ZRD) segments.
;
; Input:
; 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.
; VAFHLS - (optional) HL7 field separator.
; VAFARRY - (optional) user-supplied array name which will
; hold HL7 ZRD segments. Otherwise, ^TMP("VAFZRD",$J
; will be used.
;
; Output:
; Array containing the HL7 ZRD segments.
;
N VAFINDX,VAFSUB,VAFNODE,VAFY,X
S VAFARRY=$G(VAFARRY)
;
; if VAFHLQ or VAFHLFS not passed, use default HL7 variables
S VAFHLQ=$S($D(VAFHLQ):VAFHLQ,1:$G(HLQ)),VAFHLFS=$S($D(VAFHLFS):VAFHLFS,1:$G(HLFS))
;
; if VAFARRY not defined, use ^TMP("VAFZRD",$J)
S:(VAFARRY="") VAFARRY="^TMP(""VAFZRD"",$J)"
;
; if DFN not passed, exit
I '$G(DFN) S @VAFARRY@(1,0)="ZRD"_VAFHLFS_1 G ENQ
;
; if VAFSTR not passed, return all data fields
I $G(VAFSTR)']"" S VAFSTR="1,2,3,4,12,13,14"
S (VAFINDX,VAFSUB)=0,VAFSTR=","_VAFSTR_","
;
; get all rated disabilities for patient
F S VAFSUB=$O(^DPT(DFN,.372,VAFSUB)) Q:'VAFSUB D
.;
.; - get rated disabilities node
.S VAFNODE=$G(^DPT(DFN,.372,+VAFSUB,0))
.;
.; - build array of ZRD segments
.D BUILD
;
; if no rated disabilities, build ZRD
I 'VAFINDX D
.S @VAFARRY@(1,0)="ZRD"_VAFHLFS_1_VAFHLFS_VAFHLFS_VAFHLFS
;
ENQ Q
;
;
BUILD ; Build array of ZRD segments
N DCNODE ;0 node of Disability Condition
N DXCODE
N NAME
;
;if the Rated Disability node doesn't point to a Disability Condition,
;then the data is meaningless and should not be sent
Q:'$P(VAFNODE,"^")
S DCNODE=$G(^DIC(31,$P(VAFNODE,"^"),0))
S DXCODE=$P(DCNODE,"^",3)
Q:DXCODE=""
S NAME=$P(DCNODE,"^",1)
;
S VAFINDX=VAFINDX+1,$P(VAFY,"^",4)=""
S $P(VAFY,VAFHLFS,1)=VAFINDX ; Set ID
I VAFSTR[",2," S $P(VAFY,VAFHLFS,2)=DXCODE_$E($G(HLECH))_NAME ;Disabilty Condition
I VAFSTR[",3," S $P(VAFY,VAFHLFS,3)=$S($P(VAFNODE,"^",2)]"":$P(VAFNODE,"^",2),1:VAFHLQ) ; Disability %
I VAFSTR[",4," S $P(VAFY,VAFHLFS,4)=$S($P(VAFNODE,"^",3)]"":$P(VAFNODE,"^",3),1:VAFHLQ) ; Service Connected?
;
; *** PJH - DG*5.3*754 data fields added ***
I VAFSTR[",12," S $P(VAFY,VAFHLFS,12)=$S($P(VAFNODE,"^",4)]"":$P(VAFNODE,"^",4),1:VAFHLQ) ; Extremity
I VAFSTR[",13," S $P(VAFY,VAFHLFS,13)=$S($P(VAFNODE,"^",5)]"":$$HLDATE^HLFNC($P(VAFNODE,"^",5)),1:VAFHLQ) ; Original Effective Date
I VAFSTR[",14," S $P(VAFY,VAFHLFS,14)=$S($P(VAFNODE,"^",6)]"":$$HLDATE^HLFNC($P(VAFNODE,"^",6)),1:VAFHLQ) ; Current Effective Date
;
; set segment into array
S @VAFARRY@(VAFINDX,0)="ZRD"_VAFHLFS_$G(VAFY)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HVAFHLZRD 3067 printed Dec 13, 2024@03:03:37 Page 2
VAFHLZRD ;ALB/KCL,PJH - CREATE HL7 RATED DISABILITIES (ZRD) SEGMENTS ; 5/31/07 2:59pm
+1 ;;5.3;Registration;**122,144,754**;Aug 13,1993;Build 46
+2 ;
+3 ;
+4 ; This generic function creates HL7 VA-Specific Rated Disabilities
+5 ; (ZRD) segments for a patient.
+6 ;
EN(DFN,VAFSTR,VAFHLQ,VAFHLFS,VAFARRY) ;--
+1 ; Entry point to return HL7 Rated Disabilities (ZRD) segments.
+2 ;
+3 ; Input:
+4 ; DFN - internal entry number of Patient (#2) file
+5 ; VAFSTR - (optional) string of fields requested, separated
+6 ; by commas. If not passed return all data fields.
+7 ; VAFHLQ - (optional) HL7 null variable.
+8 ; VAFHLS - (optional) HL7 field separator.
+9 ; VAFARRY - (optional) user-supplied array name which will
+10 ; hold HL7 ZRD segments. Otherwise, ^TMP("VAFZRD",$J
+11 ; will be used.
+12 ;
+13 ; Output:
+14 ; Array containing the HL7 ZRD segments.
+15 ;
+16 NEW VAFINDX,VAFSUB,VAFNODE,VAFY,X
+17 SET VAFARRY=$GET(VAFARRY)
+18 ;
+19 ; if VAFHLQ or VAFHLFS not passed, use default HL7 variables
+20 SET VAFHLQ=$SELECT($DATA(VAFHLQ):VAFHLQ,1:$GET(HLQ))
SET VAFHLFS=$SELECT($DATA(VAFHLFS):VAFHLFS,1:$GET(HLFS))
+21 ;
+22 ; if VAFARRY not defined, use ^TMP("VAFZRD",$J)
+23 if (VAFARRY="")
SET VAFARRY="^TMP(""VAFZRD"",$J)"
+24 ;
+25 ; if DFN not passed, exit
+26 IF '$GET(DFN)
SET @VAFARRY@(1,0)="ZRD"_VAFHLFS_1
GOTO ENQ
+27 ;
+28 ; if VAFSTR not passed, return all data fields
+29 IF $GET(VAFSTR)']""
SET VAFSTR="1,2,3,4,12,13,14"
+30 SET (VAFINDX,VAFSUB)=0
SET VAFSTR=","_VAFSTR_","
+31 ;
+32 ; get all rated disabilities for patient
+33 FOR
SET VAFSUB=$ORDER(^DPT(DFN,.372,VAFSUB))
if 'VAFSUB
QUIT
Begin DoDot:1
+34 ;
+35 ; - get rated disabilities node
+36 SET VAFNODE=$GET(^DPT(DFN,.372,+VAFSUB,0))
+37 ;
+38 ; - build array of ZRD segments
+39 DO BUILD
End DoDot:1
+40 ;
+41 ; if no rated disabilities, build ZRD
+42 IF 'VAFINDX
Begin DoDot:1
+43 SET @VAFARRY@(1,0)="ZRD"_VAFHLFS_1_VAFHLFS_VAFHLFS_VAFHLFS
End DoDot:1
+44 ;
ENQ QUIT
+1 ;
+2 ;
BUILD ; Build array of ZRD segments
+1 ;0 node of Disability Condition
NEW DCNODE
+2 NEW DXCODE
+3 NEW NAME
+4 ;
+5 ;if the Rated Disability node doesn't point to a Disability Condition,
+6 ;then the data is meaningless and should not be sent
+7 if '$PIECE(VAFNODE,"^")
QUIT
+8 SET DCNODE=$GET(^DIC(31,$PIECE(VAFNODE,"^"),0))
+9 SET DXCODE=$PIECE(DCNODE,"^",3)
+10 if DXCODE=""
QUIT
+11 SET NAME=$PIECE(DCNODE,"^",1)
+12 ;
+13 SET VAFINDX=VAFINDX+1
SET $PIECE(VAFY,"^",4)=""
+14 ; Set ID
SET $PIECE(VAFY,VAFHLFS,1)=VAFINDX
+15 ;Disabilty Condition
IF VAFSTR[",2,"
SET $PIECE(VAFY,VAFHLFS,2)=DXCODE_$EXTRACT($GET(HLECH))_NAME
+16 ; Disability %
IF VAFSTR[",3,"
SET $PIECE(VAFY,VAFHLFS,3)=$SELECT($PIECE(VAFNODE,"^",2)]"":$PIECE(VAFNODE,"^",2),1:VAFHLQ)
+17 ; Service Connected?
IF VAFSTR[",4,"
SET $PIECE(VAFY,VAFHLFS,4)=$SELECT($PIECE(VAFNODE,"^",3)]"":$PIECE(VAFNODE,"^",3),1:VAFHLQ)
+18 ;
+19 ; *** PJH - DG*5.3*754 data fields added ***
+20 ; Extremity
IF VAFSTR[",12,"
SET $PIECE(VAFY,VAFHLFS,12)=$SELECT($PIECE(VAFNODE,"^",4)]"":$PIECE(VAFNODE,"^",4),1:VAFHLQ)
+21 ; Original Effective Date
IF VAFSTR[",13,"
SET $PIECE(VAFY,VAFHLFS,13)=$SELECT($PIECE(VAFNODE,"^",5)]"":$$HLDATE^HLFNC($PIECE(VAFNODE,"^",5)),1:VAFHLQ)
+22 ; Current Effective Date
IF VAFSTR[",14,"
SET $PIECE(VAFY,VAFHLFS,14)=$SELECT($PIECE(VAFNODE,"^",6)]"":$$HLDATE^HLFNC($PIECE(VAFNODE,"^",6)),1:VAFHLQ)
+23 ;
+24 ; set segment into array
+25 SET @VAFARRY@(VAFINDX,0)="ZRD"_VAFHLFS_$GET(VAFY)
+26 QUIT
