VAFHLZM2 ;ALB/KCL,PJH,LBD,DJS - Create HL7 Military History segment (ZMH) Cont ;11 Oct 2017 2:45pm
;;5.3;Registration;**673,797,935**;Aug 13, 1993;Build 53
;
;--------------------------------------------------------------------------------
;This routine creates HL7 VA-specific Military History ("ZMH") segments. It is a
;continuation of VAFHLZM1 and uses variables from both VAFHLZMH and VAFHLZM1.
;--------------------------------------------------------------------------------
;
;no direct entry
Q
;
;
OEIF ;Build Operation Enduring/Iraqi Freedom segments
;
N VAFDATA,VAFFROM,VAFIDX,VAFNODE,VAFSITE,VAFTO,VAFTYPE
;
;need to build segment even if no data in OEIF array
S $P(VAFY,VAFHLS,2)="OEIF"
I VAFSTR[",3," S $P(VAFY,VAFHLS,3)=VAFHLQ_$E(VAFHLC)_VAFHLQ
I VAFSTR[",4," S $P(VAFY,VAFHLS,4)=VAFHLQ_$E(VAFHLC)_VAFHLQ
I VAFSTR[",5," S $P(VAFY,VAFHLS,5)=VAFHLQ
Q:'$D(VAFOPS)
;
;if data in OEIF array, build segment for each episode
S (VAFNODE,VAFIDX)=0
F S VAFNODE=$O(VAFOPS(VAFNODE)) Q:'$G(VAFNODE) D
.;
.S VAFDATA=$G(VAFOPS(VAFNODE))
.;
.I VAFSTR[",3," D
..S VAFTYPE=$$EXTERNAL^DILFD(2.3215,.01,"F",$P(VAFDATA,U,1)) I VAFTYPE']"" S VAFTYPE=VAFHLQ
..S VAFSITE=$$STATION^VAFHLFNC($P(VAFDATA,U,6)) I VAFSITE="" S VAFSITE=VAFHLQ
..S $P(VAFY,VAFHLS,3)=VAFTYPE_$E(VAFHLC)_VAFSITE
.;
.I VAFSTR[",4," D
..S VAFFROM=$P(VAFDATA,U,2) S VAFFROM=$S(VAFFROM:$$HLDATE^HLFNC(VAFFROM),1:VAFHLQ)
..S VAFTO=$P(VAFDATA,U,3) S VAFTO=$S(VAFTO:$$HLDATE^HLFNC(VAFTO),1:VAFHLQ)
..S $P(VAFY,VAFHLS,4)=VAFFROM_$E(VAFHLC)_VAFTO
.;
.I VAFSTR[",5," D
..S $P(VAFY,VAFHLS,5)=VAFHLQ
.;
.;put segment into array
.S VAFIDX=VAFIDX+1
.S VAFY(VAFIDX)=$G(VAFY)
;
Q
;
;
NOSEG ;
Q
;
MSDS ;Returns all service episodes from ESR sourced data
;
N BRANCH,COMP,DA,DATE,DONE,DTYP,EDATA,EDATE,NUM,SDATE,SERVNO,VAFIDX
S DATE="",(NUM,VAFIDX)=0
;Scan back through entry dates for service episodes
F S DATE=$O(^DPT(DFN,.3216,"B",DATE),-1) Q:'DATE D
.S DA=$O(^DPT(DFN,.3216,"B",DATE,0)) Q:'DA
.S EDATA=$G(^DPT(DFN,.3216,DA,0)) Q:EDATA=""
.;DJS, skip an MSE that has Future Discharge Date; DG*5.3*935
.Q:$P(EDATA,U,8)'=""
.S NUM=NUM+1
.S SDATE=$P(EDATA,U,2),EDATE=DATE
.S BRANCH=$P(EDATA,U,3),COMP=$P(EDATA,U,4)
.S SERVNO=$P(EDATA,U,5),DTYP=$P(EDATA,U,6)
.S $P(VAFY,VAFHLS,2)=$S(NUM=1:"SL",NUM=2:"SNL",NUM=3:"SNNL",1:"MSD")
.I VAFSTR[",3," D
..S BRANCH=$S(BRANCH:$P($G(^DIC(23,BRANCH,0)),U),1:VAFHLQ)
..I SERVNO="" S SERVNO=VAFHLQ
..S DTYP=$S(DTYP:$P($G(^DIC(25,DTYP,0)),U),1:VAFHLQ)
..; Service branch~Service number~Service discharge type
..S $P(VAFY,VAFHLS,3)=BRANCH_$E(VAFHLC)_SERVNO_$E(VAFHLC)_DTYP
.I VAFSTR[",4," D
..S EDATE=$S(EDATE:$$HLDATE^HLFNC(EDATE),1:VAFHLQ)
..S SDATE=$S(SDATE:$$HLDATE^HLFNC(SDATE),1:VAFHLQ)
..; Service entry date~Service separation date
..S $P(VAFY,VAFHLS,4)=EDATE_$E(VAFHLC)_SDATE
.I VAFSTR[",5," D
..; Service Component [L]
..I COMP="" S COMP=VAFHLQ
..S $P(VAFY,VAFHLS,5)=COMP
.;
.;put segment into array
.S VAFIDX=VAFIDX+1
.S VAFY(VAFIDX)=$G(VAFY)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HVAFHLZM2 3110 printed Apr 09, 2024@21:44:15 Page 2
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
+2 ;
+3 ;--------------------------------------------------------------------------------
+4 ;This routine creates HL7 VA-specific Military History ("ZMH") segments. It is a
+5 ;continuation of VAFHLZM1 and uses variables from both VAFHLZMH and VAFHLZM1.
+6 ;--------------------------------------------------------------------------------
+7 ;
+8 ;no direct entry
+9 QUIT
+10 ;
+11 ;
OEIF ;Build Operation Enduring/Iraqi Freedom segments
+1 ;
+2 NEW VAFDATA,VAFFROM,VAFIDX,VAFNODE,VAFSITE,VAFTO,VAFTYPE
+3 ;
+4 ;need to build segment even if no data in OEIF array
+5 SET $PIECE(VAFY,VAFHLS,2)="OEIF"
+6 IF VAFSTR[",3,"
SET $PIECE(VAFY,VAFHLS,3)=VAFHLQ_$EXTRACT(VAFHLC)_VAFHLQ
+7 IF VAFSTR[",4,"
SET $PIECE(VAFY,VAFHLS,4)=VAFHLQ_$EXTRACT(VAFHLC)_VAFHLQ
+8 IF VAFSTR[",5,"
SET $PIECE(VAFY,VAFHLS,5)=VAFHLQ
+9 if '$DATA(VAFOPS)
QUIT
+10 ;
+11 ;if data in OEIF array, build segment for each episode
+12 SET (VAFNODE,VAFIDX)=0
+13 FOR
SET VAFNODE=$ORDER(VAFOPS(VAFNODE))
if '$GET(VAFNODE)
QUIT
Begin DoDot:1
+14 ;
+15 SET VAFDATA=$GET(VAFOPS(VAFNODE))
+16 ;
+17 IF VAFSTR[",3,"
Begin DoDot:2
+18 SET VAFTYPE=$$EXTERNAL^DILFD(2.3215,.01,"F",$PIECE(VAFDATA,U,1))
IF VAFTYPE']""
SET VAFTYPE=VAFHLQ
+19 SET VAFSITE=$$STATION^VAFHLFNC($PIECE(VAFDATA,U,6))
IF VAFSITE=""
SET VAFSITE=VAFHLQ
+20 SET $PIECE(VAFY,VAFHLS,3)=VAFTYPE_$EXTRACT(VAFHLC)_VAFSITE
End DoDot:2
+21 ;
+22 IF VAFSTR[",4,"
Begin DoDot:2
+23 SET VAFFROM=$PIECE(VAFDATA,U,2)
SET VAFFROM=$SELECT(VAFFROM:$$HLDATE^HLFNC(VAFFROM),1:VAFHLQ)
+24 SET VAFTO=$PIECE(VAFDATA,U,3)
SET VAFTO=$SELECT(VAFTO:$$HLDATE^HLFNC(VAFTO),1:VAFHLQ)
+25 SET $PIECE(VAFY,VAFHLS,4)=VAFFROM_$EXTRACT(VAFHLC)_VAFTO
End DoDot:2
+26 ;
+27 IF VAFSTR[",5,"
Begin DoDot:2
+28 SET $PIECE(VAFY,VAFHLS,5)=VAFHLQ
End DoDot:2
+29 ;
+30 ;put segment into array
+31 SET VAFIDX=VAFIDX+1
+32 SET VAFY(VAFIDX)=$GET(VAFY)
End DoDot:1
+33 ;
+34 QUIT
+35 ;
+36 ;
NOSEG ;
+1 QUIT
+2 ;
MSDS ;Returns all service episodes from ESR sourced data
+1 ;
+2 NEW BRANCH,COMP,DA,DATE,DONE,DTYP,EDATA,EDATE,NUM,SDATE,SERVNO,VAFIDX
+3 SET DATE=""
SET (NUM,VAFIDX)=0
+4 ;Scan back through entry dates for service episodes
+5 FOR
SET DATE=$ORDER(^DPT(DFN,.3216,"B",DATE),-1)
if 'DATE
QUIT
Begin DoDot:1
+6 SET DA=$ORDER(^DPT(DFN,.3216,"B",DATE,0))
if 'DA
QUIT
+7 SET EDATA=$GET(^DPT(DFN,.3216,DA,0))
if EDATA=""
QUIT
+8 ;DJS, skip an MSE that has Future Discharge Date; DG*5.3*935
+9 if $PIECE(EDATA,U,8)'=""
QUIT
+10 SET NUM=NUM+1
+11 SET SDATE=$PIECE(EDATA,U,2)
SET EDATE=DATE
+12 SET BRANCH=$PIECE(EDATA,U,3)
SET COMP=$PIECE(EDATA,U,4)
+13 SET SERVNO=$PIECE(EDATA,U,5)
SET DTYP=$PIECE(EDATA,U,6)
+14 SET $PIECE(VAFY,VAFHLS,2)=$SELECT(NUM=1:"SL",NUM=2:"SNL",NUM=3:"SNNL",1:"MSD")
+15 IF VAFSTR[",3,"
Begin DoDot:2
+16 SET BRANCH=$SELECT(BRANCH:$PIECE($GET(^DIC(23,BRANCH,0)),U),1:VAFHLQ)
+17 IF SERVNO=""
SET SERVNO=VAFHLQ
+18 SET DTYP=$SELECT(DTYP:$PIECE($GET(^DIC(25,DTYP,0)),U),1:VAFHLQ)
+19 ; Service branch~Service number~Service discharge type
+20 SET $PIECE(VAFY,VAFHLS,3)=BRANCH_$EXTRACT(VAFHLC)_SERVNO_$EXTRACT(VAFHLC)_DTYP
End DoDot:2
+21 IF VAFSTR[",4,"
Begin DoDot:2
+22 SET EDATE=$SELECT(EDATE:$$HLDATE^HLFNC(EDATE),1:VAFHLQ)
+23 SET SDATE=$SELECT(SDATE:$$HLDATE^HLFNC(SDATE),1:VAFHLQ)
+24 ; Service entry date~Service separation date
+25 SET $PIECE(VAFY,VAFHLS,4)=EDATE_$EXTRACT(VAFHLC)_SDATE
End DoDot:2
+26 IF VAFSTR[",5,"
Begin DoDot:2
+27 ; Service Component [L]
+28 IF COMP=""
SET COMP=VAFHLQ
+29 SET $PIECE(VAFY,VAFHLS,5)=COMP
End DoDot:2
+30 ;
+31 ;put segment into array
+32 SET VAFIDX=VAFIDX+1
+33 SET VAFY(VAFIDX)=$GET(VAFY)
End DoDot:1
+34 QUIT
