Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: VAFHLZRD

VAFHLZRD.m

Go to the documentation of this file.
  1. 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
  1. ;
  1. ;
  1. ; This generic function creates HL7 VA-Specific Rated Disabilities
  1. ; (ZRD) segments for a patient.
  1. ;
  1. EN(DFN,VAFSTR,VAFHLQ,VAFHLFS,VAFARRY) ;--
  1. ; Entry point to return HL7 Rated Disabilities (ZRD) segments.
  1. ;
  1. ; Input:
  1. ; DFN - internal entry number of Patient (#2) file
  1. ; VAFSTR - (optional) string of fields requested, separated
  1. ; by commas. If not passed return all data fields.
  1. ; VAFHLQ - (optional) HL7 null variable.
  1. ; VAFHLS - (optional) HL7 field separator.
  1. ; VAFARRY - (optional) user-supplied array name which will
  1. ; hold HL7 ZRD segments. Otherwise, ^TMP("VAFZRD",$J
  1. ; will be used.
  1. ;
  1. ; Output:
  1. ; Array containing the HL7 ZRD segments.
  1. ;
  1. N VAFINDX,VAFSUB,VAFNODE,VAFY,X
  1. S VAFARRY=$G(VAFARRY)
  1. ;
  1. ; if VAFHLQ or VAFHLFS not passed, use default HL7 variables
  1. S VAFHLQ=$S($D(VAFHLQ):VAFHLQ,1:$G(HLQ)),VAFHLFS=$S($D(VAFHLFS):VAFHLFS,1:$G(HLFS))
  1. ;
  1. ; if VAFARRY not defined, use ^TMP("VAFZRD",$J)
  1. S:(VAFARRY="") VAFARRY="^TMP(""VAFZRD"",$J)"
  1. ;
  1. ; if DFN not passed, exit
  1. I '$G(DFN) S @VAFARRY@(1,0)="ZRD"_VAFHLFS_1 G ENQ
  1. ;
  1. ; if VAFSTR not passed, return all data fields
  1. I $G(VAFSTR)']"" S VAFSTR="1,2,3,4,12,13,14"
  1. S (VAFINDX,VAFSUB)=0,VAFSTR=","_VAFSTR_","
  1. ;
  1. ; get all rated disabilities for patient
  1. F S VAFSUB=$O(^DPT(DFN,.372,VAFSUB)) Q:'VAFSUB D
  1. .;
  1. .; - get rated disabilities node
  1. .S VAFNODE=$G(^DPT(DFN,.372,+VAFSUB,0))
  1. .;
  1. .; - build array of ZRD segments
  1. .D BUILD
  1. ;
  1. ; if no rated disabilities, build ZRD
  1. I 'VAFINDX D
  1. .S @VAFARRY@(1,0)="ZRD"_VAFHLFS_1_VAFHLFS_VAFHLFS_VAFHLFS
  1. ;
  1. ENQ Q
  1. ;
  1. ;
  1. BUILD ; Build array of ZRD segments
  1. N DCNODE ;0 node of Disability Condition
  1. N DXCODE
  1. N NAME
  1. ;
  1. ;if the Rated Disability node doesn't point to a Disability Condition,
  1. ;then the data is meaningless and should not be sent
  1. Q:'$P(VAFNODE,"^")
  1. S DCNODE=$G(^DIC(31,$P(VAFNODE,"^"),0))
  1. S DXCODE=$P(DCNODE,"^",3)
  1. Q:DXCODE=""
  1. S NAME=$P(DCNODE,"^",1)
  1. ;
  1. S VAFINDX=VAFINDX+1,$P(VAFY,"^",4)=""
  1. S $P(VAFY,VAFHLFS,1)=VAFINDX ; Set ID
  1. I VAFSTR[",2," S $P(VAFY,VAFHLFS,2)=DXCODE_$E($G(HLECH))_NAME ;Disabilty Condition
  1. I VAFSTR[",3," S $P(VAFY,VAFHLFS,3)=$S($P(VAFNODE,"^",2)]"":$P(VAFNODE,"^",2),1:VAFHLQ) ; Disability %
  1. I VAFSTR[",4," S $P(VAFY,VAFHLFS,4)=$S($P(VAFNODE,"^",3)]"":$P(VAFNODE,"^",3),1:VAFHLQ) ; Service Connected?
  1. ;
  1. ; *** PJH - DG*5.3*754 data fields added ***
  1. I VAFSTR[",12," S $P(VAFY,VAFHLFS,12)=$S($P(VAFNODE,"^",4)]"":$P(VAFNODE,"^",4),1:VAFHLQ) ; Extremity
  1. I VAFSTR[",13," S $P(VAFY,VAFHLFS,13)=$S($P(VAFNODE,"^",5)]"":$$HLDATE^HLFNC($P(VAFNODE,"^",5)),1:VAFHLQ) ; Original Effective Date
  1. I VAFSTR[",14," S $P(VAFY,VAFHLFS,14)=$S($P(VAFNODE,"^",6)]"":$$HLDATE^HLFNC($P(VAFNODE,"^",6)),1:VAFHLQ) ; Current Effective Date
  1. ;
  1. ; set segment into array
  1. S @VAFARRY@(VAFINDX,0)="ZRD"_VAFHLFS_$G(VAFY)
  1. Q