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