- 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 Mar 13, 2025@22:08:18 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