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

VAFHLZM2.m

Go to the documentation of this file. 
  1. VAFHLZM2 ;ALB/KCL,PJH,LBD,DJS - Create HL7 Military History segment (ZMH) Cont ;11 Oct 2017 2:45pm
  1.  ;;5.3;Registration;**673,797,935**;Aug 13, 1993;Build 53
  1.  ;
  1.  ;--------------------------------------------------------------------------------
  1.  ;This routine creates HL7 VA-specific Military History ("ZMH") segments. It is a
  1.  ;continuation of VAFHLZM1 and uses variables from both VAFHLZMH and VAFHLZM1.
  1.  ;--------------------------------------------------------------------------------
  1.  ;
  1.  ;no direct entry
  1.  Q
  1.  ;
  1.  ;
  1. OEIF ;Build Operation Enduring/Iraqi Freedom segments
  1.  ;
  1.  N VAFDATA,VAFFROM,VAFIDX,VAFNODE,VAFSITE,VAFTO,VAFTYPE
  1.  ;
  1.  ;need to build segment even if no data in OEIF array 
  1.  S $P(VAFY,VAFHLS,2)="OEIF"
  1.  I VAFSTR[",3," S $P(VAFY,VAFHLS,3)=VAFHLQ_$E(VAFHLC)_VAFHLQ
  1.  I VAFSTR[",4," S $P(VAFY,VAFHLS,4)=VAFHLQ_$E(VAFHLC)_VAFHLQ
  1.  I VAFSTR[",5," S $P(VAFY,VAFHLS,5)=VAFHLQ
  1.  Q:'$D(VAFOPS)
  1.  ;
  1.  ;if data in OEIF array, build segment for each episode
  1.  S (VAFNODE,VAFIDX)=0
  1.  F  S VAFNODE=$O(VAFOPS(VAFNODE)) Q:'$G(VAFNODE)  D
  1.  .;
  1.  .S VAFDATA=$G(VAFOPS(VAFNODE))
  1.  .;
  1.  .I VAFSTR[",3," D
  1.  ..S VAFTYPE=$$EXTERNAL^DILFD(2.3215,.01,"F",$P(VAFDATA,U,1)) I VAFTYPE']"" S VAFTYPE=VAFHLQ
  1.  ..S VAFSITE=$$STATION^VAFHLFNC($P(VAFDATA,U,6)) I VAFSITE="" S VAFSITE=VAFHLQ
  1.  ..S $P(VAFY,VAFHLS,3)=VAFTYPE_$E(VAFHLC)_VAFSITE
  1.  .;
  1.  .I VAFSTR[",4," D
  1.  ..S VAFFROM=$P(VAFDATA,U,2) S VAFFROM=$S(VAFFROM:$$HLDATE^HLFNC(VAFFROM),1:VAFHLQ)
  1.  ..S VAFTO=$P(VAFDATA,U,3) S VAFTO=$S(VAFTO:$$HLDATE^HLFNC(VAFTO),1:VAFHLQ)
  1.  ..S $P(VAFY,VAFHLS,4)=VAFFROM_$E(VAFHLC)_VAFTO
  1.  .;
  1.  .I VAFSTR[",5," D
  1.  ..S $P(VAFY,VAFHLS,5)=VAFHLQ
  1.  .;
  1.  .;put segment into array
  1.  .S VAFIDX=VAFIDX+1
  1.  .S VAFY(VAFIDX)=$G(VAFY)
  1.  ;
  1.  Q
  1.  ;
  1.  ;
  1. NOSEG ;
  1.  Q
  1.  ;
  1. MSDS ;Returns all service episodes from ESR sourced data
  1.  ;
  1.  N BRANCH,COMP,DA,DATE,DONE,DTYP,EDATA,EDATE,NUM,SDATE,SERVNO,VAFIDX
  1.  S DATE="",(NUM,VAFIDX)=0
  1.  ;Scan back through entry dates for service episodes
  1.  F  S DATE=$O(^DPT(DFN,.3216,"B",DATE),-1) Q:'DATE  D
  1.  .S DA=$O(^DPT(DFN,.3216,"B",DATE,0)) Q:'DA
  1.  .S EDATA=$G(^DPT(DFN,.3216,DA,0)) Q:EDATA=""
  1.  .;DJS, skip an MSE that has Future Discharge Date; DG*5.3*935
  1.  .Q:$P(EDATA,U,8)'=""
  1.  .S NUM=NUM+1
  1.  .S SDATE=$P(EDATA,U,2),EDATE=DATE
  1.  .S BRANCH=$P(EDATA,U,3),COMP=$P(EDATA,U,4)
  1.  .S SERVNO=$P(EDATA,U,5),DTYP=$P(EDATA,U,6)
  1.  .S $P(VAFY,VAFHLS,2)=$S(NUM=1:"SL",NUM=2:"SNL",NUM=3:"SNNL",1:"MSD")
  1.  .I VAFSTR[",3," D
  1.  ..S BRANCH=$S(BRANCH:$P($G(^DIC(23,BRANCH,0)),U),1:VAFHLQ)
  1.  ..I SERVNO="" S SERVNO=VAFHLQ
  1.  ..S DTYP=$S(DTYP:$P($G(^DIC(25,DTYP,0)),U),1:VAFHLQ)
  1.  ..; Service branch~Service number~Service discharge type
  1.  ..S $P(VAFY,VAFHLS,3)=BRANCH_$E(VAFHLC)_SERVNO_$E(VAFHLC)_DTYP
  1.  .I VAFSTR[",4," D
  1.  ..S EDATE=$S(EDATE:$$HLDATE^HLFNC(EDATE),1:VAFHLQ)
  1.  ..S SDATE=$S(SDATE:$$HLDATE^HLFNC(SDATE),1:VAFHLQ)
  1.  ..; Service entry date~Service separation date
  1.  ..S $P(VAFY,VAFHLS,4)=EDATE_$E(VAFHLC)_SDATE
  1.  .I VAFSTR[",5," D
  1.  ..; Service Component [L]
  1.  ..I COMP="" S COMP=VAFHLQ
  1.  ..S $P(VAFY,VAFHLS,5)=COMP
  1.  .;
  1.  .;put segment into array
  1.  .S VAFIDX=VAFIDX+1
  1.  .S VAFY(VAFIDX)=$G(VAFY)
  1.  Q