VAFHLZM1 ;BAY/JAT,PJH - Create HL7 Military History segment (ZMH) Cont ; 2/3/09 3:49pm
;;5.3;Registration;**314,673,797**;Aug 13, 1993;Build 24
;
; This routine creates HL7 VA-specific Military History ("ZMH") segments
; It is a continuation of VAFHLZMH and uses those variables.
;
Q
ENTER ;
N VAFSETID ;seg setid
S VAFSETID=0
N VAFNUM
;build segments as requested in VAFTYPE
F VAFX=1:1 S VAFZ=$P(VAFTYPE,",",VAFX) Q:VAFZ="" D
.S VAFY=""
.S VAFINDX=(VAFINDX\1)+1
.S VAFSETID=VAFSETID+1
.S $P(VAFY,VAFHLS,1)=VAFSETID
.S VAFTAG=$S(VAFZ="*":"MSDS",VAFZ=1:"SL",VAFZ=2:"SNL",VAFZ=3:"SNNL",VAFZ=4:"POW",VAFZ=5:"COMB",VAFZ=6:"VIET",VAFZ=7:"LEBA",VAFZ=8:"GREN",VAFZ=9:"PANA",VAFZ=10:"GULF",VAFZ=11:"SOMA",VAFZ=12:"YUGO",VAFZ=13:"PH",VAFZ=14:"OEIF",1:"NOSEG")
.D @VAFTAG
.;if mult episodes, add decimal to output array subscript (Ex: 14.001)
.I $D(VAFY(2)) D
..S VAFNUM=0
..F S VAFNUM=$O(VAFY(VAFNUM)) Q:'$G(VAFNUM) D
...S VAFINDX=VAFINDX+.001
...;if >1 conflict then increment seg setid
...I VAFNUM>1 S VAFSETID=VAFSETID+1 S $P(VAFY(VAFNUM),VAFHLS,1)=VAFSETID
...S @VAFARRAY@(VAFINDX,0)="ZMH"_VAFHLS_$G(VAFY(VAFNUM))
.;if not mult episodes
.I '$D(VAFY(2)) S @VAFARRAY@(VAFINDX,0)="ZMH"_VAFHLS_$G(VAFY)
.K VAFY
Q
SL ; last Service branch
S $P(VAFY,VAFHLS,2)="SL"
N VAF325,VAF328,VAF324,VAF326,VAF327,VAFSCL
I VAFSTR[",3," D
.S VAF325=$P(VAF32N,U,5) S VAF325=$S(VAF325:$P($G(^DIC(23,VAF325,0)),U),1:VAFHLQ)
.S VAF328=$P(VAF32N,U,8) I VAF328="" S VAF328=VAFHLQ
.S VAF324=$P(VAF32N,U,4) S VAF324=$S(VAF324:$P($G(^DIC(25,VAF324,0)),U),1:VAFHLQ)
.; Service branch~Service number~Service discharge type
.S $P(VAFY,VAFHLS,3)=VAF325_$E(VAFHLC)_VAF328_$E(VAFHLC)_VAF324
I VAFSTR[",4," D
.S VAF326=$P(VAF32N,U,6) S VAF326=$S(VAF326:$$HLDATE^HLFNC(VAF326),1:VAFHLQ)
.S VAF327=$P(VAF32N,U,7) S VAF327=$S(VAF327:$$HLDATE^HLFNC(VAF327),1:VAFHLQ)
.; Service entry date~Service separation date
.S $P(VAFY,VAFHLS,4)=VAF326_$E(VAFHLC)_VAF327
I VAFSTR[",5," D
.; Service Component [L]
.S VAFSCL=$P(VAF3291N,U,1) I VAFSCL="" S VAFSCL=VAFHLQ
.S $P(VAFY,VAFHLS,5)=VAFSCL
Q
SNL ; next to last Service branch
S $P(VAFY,VAFHLS,2)="SNL"
N VAF3291,VAF3294,VAF329,VAF3292,VAF3293,VAFSCNL
I VAFSTR[",3," D
.S VAF3291=$P(VAF32N,U,10) S VAF3291=$S(VAF3291:$P($G(^DIC(23,VAF3291,0)),U),1:VAFHLQ)
.S VAF3294=$P(VAF32N,U,13) I VAF3294="" S VAF3294=VAFHLQ
.S VAF329=$P(VAF32N,U,9) S VAF329=$S(VAF329:$P($G(^DIC(25,VAF329,0)),U),1:VAFHLQ)
.S $P(VAFY,VAFHLS,3)=VAF3291_$E(VAFHLC)_VAF3294_$E(VAFHLC)_VAF329
I VAFSTR[",4," D
.S VAF3292=$P(VAF32N,U,11) S VAF3292=$S(VAF3292:$$HLDATE^HLFNC(VAF3292),1:VAFHLQ)
.S VAF3293=$P(VAF32N,U,12) S VAF3293=$S(VAF3293:$$HLDATE^HLFNC(VAF3293),1:VAFHLQ)
.S $P(VAFY,VAFHLS,4)=VAF3292_$E(VAFHLC)_VAF3293
I VAFSTR[",5," D
.; Service Component [NL]
.S VAFSCNL=$P(VAF3291N,U,2) I VAFSCNL="" S VAFSCNL=VAFHLQ
.S $P(VAFY,VAFHLS,5)=VAFSCNL
Q
SNNL ; next to next to last Service branch
S $P(VAFY,VAFHLS,2)="SNNL"
N VAF3296,VAF3299,VAF3295,VAF3297,VAF3298,VAFSCNNL
I VAFSTR[",3," D
.S VAF3296=$P(VAF32N,U,15) S VAF3296=$S(VAF3296:$P($G(^DIC(23,VAF3296,0)),U),1:VAFHLQ)
.S VAF3299=$P(VAF32N,U,18) I VAF3299="" S VAF3299=VAFHLQ
.S VAF3295=$P(VAF32N,U,14) S VAF3295=$S(VAF3295:$P($G(^DIC(25,VAF3295,0)),U),1:VAFHLQ)
.S $P(VAFY,VAFHLS,3)=VAF3296_$E(VAFHLC)_VAF3299_$E(VAFHLC)_VAF3295
I VAFSTR[",4," D
.S VAF3297=$P(VAF32N,U,16) S VAF3297=$S(VAF3297:$$HLDATE^HLFNC(VAF3297),1:VAFHLQ)
.S VAF3298=$P(VAF32N,U,17) S VAF3298=$S(VAF3298:$$HLDATE^HLFNC(VAF3298),1:VAFHLQ)
.S $P(VAFY,VAFHLS,4)=VAF3297_$E(VAFHLC)_VAF3298
I VAFSTR[",5," D
.; Service Component [NNL]
.S VAFSCNNL=$P(VAF3291N,U,3) I VAFSCNNL="" S VAFSCNNL=VAFHLQ
.S $P(VAFY,VAFHLS,5)=VAFSCNNL
Q
POW ; Prisoner of War
S $P(VAFY,VAFHLS,2)="POW"
N VAF525,VAF526,VAF527,VAF528
I VAFSTR[",3," D
.S VAF525=$P(VAF52N,U,5) I VAF525="" S VAF525=VAFHLQ
.;S VAF526=$P(VAF52N,U,6) S VAF526=$S(VAF526:$P($G(^DIC(22,VAF526,0)),U),1:VAFHLQ)
.; translate pointer to coded value for VA0023 table
.S VAF526=$P(VAF52N,U,6) S VAF526=$S(VAF526>0&(VAF526<7):VAF526+3,VAF526>6&(VAF526<9):$C(VAF526+58),1:VAFHLQ)
.S $P(VAFY,VAFHLS,3)=VAF525_$E(VAFHLC)_VAF526
I VAFSTR[",4," D
.S VAF527=$P(VAF52N,U,7) S VAF527=$S(VAF527:$$HLDATE^HLFNC(VAF527),1:VAFHLQ)
.S VAF528=$P(VAF52N,U,8) S VAF528=$S(VAF528:$$HLDATE^HLFNC(VAF528),1:VAFHLQ)
.S $P(VAFY,VAFHLS,4)=VAF527_$E(VAFHLC)_VAF528
I VAFSTR[",5," S $P(VAFY,VAFHLS,5)=VAFHLQ
Q
COMB ; Combat
S $P(VAFY,VAFHLS,2)="COMB"
N VAF5291,VAF5292,VAF5293,VAF5294
I VAFSTR[",3," D
.S VAF5291=$P(VAF52N,U,11) I VAF5291="" S VAF5291=VAFHLQ
.S VAF5292=$P(VAF52N,U,12) S VAF5292=$S(VAF5292:$P($G(^DIC(22,VAF5292,0)),U),1:VAFHLQ)
.S $P(VAFY,VAFHLS,3)=VAF5291_$E(VAFHLC)_VAF5292
I VAFSTR[",4," D
.S VAF5293=$P(VAF52N,U,13) S VAF5293=$S(VAF5293:$$HLDATE^HLFNC(VAF5293),1:VAFHLQ)
.S VAF5294=$P(VAF52N,U,14) S VAF5294=$S(VAF5294:$$HLDATE^HLFNC(VAF5294),1:VAFHLQ)
.S $P(VAFY,VAFHLS,4)=VAF5293_$E(VAFHLC)_VAF5294
I VAFSTR[",5," S $P(VAFY,VAFHLS,5)=VAFHLQ
Q
VIET ; Vietnam
S $P(VAFY,VAFHLS,2)="VIET"
N VAF32101,VAF32104,VAF32105
I VAFSTR[",3," D
.S VAF32101=$P(VAF321N,U) I VAF32101="" S VAF32101=VAFHLQ
.S $P(VAFY,VAFHLS,3)=VAF32101
I VAFSTR[",4," D
.S VAF32104=$P(VAF321N,U,4) S VAF32104=$S(VAF32104:$$HLDATE^HLFNC(VAF32104),1:VAFHLQ)
.S VAF32105=$P(VAF321N,U,5) S VAF32105=$S(VAF32105:$$HLDATE^HLFNC(VAF32105),1:VAFHLQ)
.S $P(VAFY,VAFHLS,4)=VAF32104_$E(VAFHLC)_VAF32105
I VAFSTR[",5," S $P(VAFY,VAFHLS,5)=VAFHLQ
Q
LEBA ; Lebanon
S $P(VAFY,VAFHLS,2)="LEBA"
N VAF3221,VAF3222,VAF3223
I VAFSTR[",3," D
.S VAF3221=$P(VAF322N,U) I VAF3221="" S VAF3221=VAFHLQ
.S $P(VAFY,VAFHLS,3)=VAF3221
I VAFSTR[",4," D
.S VAF3222=$P(VAF322N,U,2) S VAF3222=$S(VAF3222:$$HLDATE^HLFNC(VAF3222),1:VAFHLQ)
.S VAF3223=$P(VAF322N,U,3) S VAF3223=$S(VAF3223:$$HLDATE^HLFNC(VAF3223),1:VAFHLQ)
.S $P(VAFY,VAFHLS,4)=VAF3222_$E(VAFHLC)_VAF3223
I VAFSTR[",5," S $P(VAFY,VAFHLS,5)=VAFHLQ
Q
GREN ; Grenada
S $P(VAFY,VAFHLS,2)="GREN"
N VAF3224,VAF3225,VAF3226
I VAFSTR[",3," D
.S VAF3224=$P(VAF322N,U,4) I VAF3224="" S VAF3224=VAFHLQ
.S $P(VAFY,VAFHLS,3)=VAF3224
I VAFSTR[",4," D
.S VAF3225=$P(VAF322N,U,5) S VAF3225=$S(VAF3225:$$HLDATE^HLFNC(VAF3225),1:VAFHLQ)
.S VAF3226=$P(VAF322N,U,6) S VAF3226=$S(VAF3226:$$HLDATE^HLFNC(VAF3226),1:VAFHLQ)
.S $P(VAFY,VAFHLS,4)=VAF3225_$E(VAFHLC)_VAF3226
I VAFSTR[",5," S $P(VAFY,VAFHLS,5)=VAFHLQ
Q
PANA ; Panama
S $P(VAFY,VAFHLS,2)="PANA"
N VAF3227,VAF3228,VAF3229
I VAFSTR[",3," D
.S VAF3227=$P(VAF322N,U,7) I VAF3227="" S VAF3227=VAFHLQ
.S $P(VAFY,VAFHLS,3)=VAF3227
I VAFSTR[",4," D
.S VAF3228=$P(VAF322N,U,8) S VAF3228=$S(VAF3228:$$HLDATE^HLFNC(VAF3228),1:VAFHLQ)
.S VAF3229=$P(VAF322N,U,9) S VAF3229=$S(VAF3229:$$HLDATE^HLFNC(VAF3229),1:VAFHLQ)
.S $P(VAFY,VAFHLS,4)=VAF3228_$E(VAFHLC)_VAF3229
I VAFSTR[",5," S $P(VAFY,VAFHLS,5)=VAFHLQ
Q
GULF ; Persian Gulf
S $P(VAFY,VAFHLS,2)="GULF"
N VAF32201,VA322011,VA322012
I VAFSTR[",3," D
.S VAF32201=$P(VAF322N,U,10) I VAF32201="" S VAF32201=VAFHLQ
.S $P(VAFY,VAFHLS,3)=VAF32201
I VAFSTR[",4," D
.S VA322011=$P(VAF322N,U,11) S VA322011=$S(VA322011:$$HLDATE^HLFNC(VA322011),1:VAFHLQ)
.S VA322012=$P(VAF322N,U,12) S VA322012=$S(VA322012:$$HLDATE^HLFNC(VA322012),1:VAFHLQ)
.S $P(VAFY,VAFHLS,4)=VA322011_$E(VAFHLC)_VA322012
I VAFSTR[",5," S $P(VAFY,VAFHLS,5)=VAFHLQ
Q
SOMA ; Somalia
S $P(VAFY,VAFHLS,2)="SOMA"
N VA322016,VA322017,VA322018
I VAFSTR[",3," D
.S VA322016=$P(VAF322N,U,16) I VA322016="" S VA322016=VAFHLQ
.S $P(VAFY,VAFHLS,3)=VA322016
I VAFSTR[",4," D
.S VA322017=$P(VAF322N,U,17) S VA322017=$S(VA322017:$$HLDATE^HLFNC(VA322017),1:VAFHLQ)
.S VA322018=$P(VAF322N,U,18) S VA322018=$S(VA322018:$$HLDATE^HLFNC(VA322018),1:VAFHLQ)
.S $P(VAFY,VAFHLS,4)=VA322017_$E(VAFHLC)_VA322018
I VAFSTR[",5," S $P(VAFY,VAFHLS,5)=VAFHLQ
Q
YUGO ; Yugoslavia
S $P(VAFY,VAFHLS,2)="YUGO"
N VA322019,VA32202,VA322021
I VAFSTR[",3," D
.S VA322019=$P(VAF322N,U,19) I VA322019="" S VA322019=VAFHLQ
.S $P(VAFY,VAFHLS,3)=VA322019
I VAFSTR[",4," D
.S VA32202=$P(VAF322N,U,20) S VA32202=$S(VA32202:$$HLDATE^HLFNC(VA32202),1:VAFHLQ)
.S VA322021=$P(VAF322N,U,21) S VA322021=$S(VA322021:$$HLDATE^HLFNC(VA322021),1:VAFHLQ)
.S $P(VAFY,VAFHLS,4)=VA32202_$E(VAFHLC)_VA322021
I VAFSTR[",5," S $P(VAFY,VAFHLS,5)=VAFHLQ
Q
PH ; Purple Heart Recipent
S $P(VAFY,VAFHLS,2)="PH"
N VAF531,VAF532,VAF533
I VAFSTR[",3," D
.S VAF531=$P(VAF53N,U,1) I VAF531="" S VAF531=VAFHLQ
.S VAF532=$P(VAF53N,U,2) I VAF532="" S VAF532=VAFHLQ
.S VAF533=$P(VAF53N,U,3) I VAF533="" S VAF533=VAFHLQ
.S $P(VAFY,VAFHLS,3)=VAF531_$E(VAFHLC)_VAF532_$E(VAFHLC)_VAF533
I VAFSTR[",4," D
.S $P(VAFY,VAFHLS,4)=VAFHLQ
I VAFSTR[",5," S $P(VAFY,VAFHLS,5)=VAFHLQ
Q
OEIF ;build Operation Enduring/Iraqi Freedom segments
D OEIF^VAFHLZM2
Q
NOSEG ;
D NOSEG^VAFHLZM2
Q
;
MSDS ;build new ZMH format for MSDS records
D MSDS^VAFHLZM2
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HVAFHLZM1 9061 printed Sep 02, 2024@19:48:47 Page 2
VAFHLZM1 ;BAY/JAT,PJH - Create HL7 Military History segment (ZMH) Cont ; 2/3/09 3:49pm
+1 ;;5.3;Registration;**314,673,797**;Aug 13, 1993;Build 24
+2 ;
+3 ; This routine creates HL7 VA-specific Military History ("ZMH") segments
+4 ; It is a continuation of VAFHLZMH and uses those variables.
+5 ;
+6 QUIT
ENTER ;
+1 ;seg setid
NEW VAFSETID
+2 SET VAFSETID=0
+3 NEW VAFNUM
+4 ;build segments as requested in VAFTYPE
+5 FOR VAFX=1:1
SET VAFZ=$PIECE(VAFTYPE,",",VAFX)
if VAFZ=""
QUIT
Begin DoDot:1
+6 SET VAFY=""
+7 SET VAFINDX=(VAFINDX\1)+1
+8 SET VAFSETID=VAFSETID+1
+9 SET $PIECE(VAFY,VAFHLS,1)=VAFSETID
+10 SET VAFTAG=$SELECT(VAFZ="*":"MSDS",VAFZ=1:"SL",VAFZ=2:"SNL",VAFZ=3:"SNNL",VAFZ=4:"POW",VAFZ=5:"COMB",VAFZ=6:"VIET",VAFZ=7:"LEBA",VAFZ=8:"GREN",VAFZ=9:"PANA",VAFZ=10:"GULF",VAFZ=11:"SOMA",VAFZ=12:"YUGO",VAFZ=13:"PH",VAFZ=14:"OEIF",1:"NOS
EG")
+11 DO @VAFTAG
+12 ;if mult episodes, add decimal to output array subscript (Ex: 14.001)
+13 IF $DATA(VAFY(2))
Begin DoDot:2
+14 SET VAFNUM=0
+15 FOR
SET VAFNUM=$ORDER(VAFY(VAFNUM))
if '$GET(VAFNUM)
QUIT
Begin DoDot:3
+16 SET VAFINDX=VAFINDX+.001
+17 ;if >1 conflict then increment seg setid
+18 IF VAFNUM>1
SET VAFSETID=VAFSETID+1
SET $PIECE(VAFY(VAFNUM),VAFHLS,1)=VAFSETID
+19 SET @VAFARRAY@(VAFINDX,0)="ZMH"_VAFHLS_$GET(VAFY(VAFNUM))
End DoDot:3
End DoDot:2
+20 ;if not mult episodes
+21 IF '$DATA(VAFY(2))
SET @VAFARRAY@(VAFINDX,0)="ZMH"_VAFHLS_$GET(VAFY)
+22 KILL VAFY
End DoDot:1
+23 QUIT
SL ; last Service branch
+1 SET $PIECE(VAFY,VAFHLS,2)="SL"
+2 NEW VAF325,VAF328,VAF324,VAF326,VAF327,VAFSCL
+3 IF VAFSTR[",3,"
Begin DoDot:1
+4 SET VAF325=$PIECE(VAF32N,U,5)
SET VAF325=$SELECT(VAF325:$PIECE($GET(^DIC(23,VAF325,0)),U),1:VAFHLQ)
+5 SET VAF328=$PIECE(VAF32N,U,8)
IF VAF328=""
SET VAF328=VAFHLQ
+6 SET VAF324=$PIECE(VAF32N,U,4)
SET VAF324=$SELECT(VAF324:$PIECE($GET(^DIC(25,VAF324,0)),U),1:VAFHLQ)
+7 ; Service branch~Service number~Service discharge type
+8 SET $PIECE(VAFY,VAFHLS,3)=VAF325_$EXTRACT(VAFHLC)_VAF328_$EXTRACT(VAFHLC)_VAF324
End DoDot:1
+9 IF VAFSTR[",4,"
Begin DoDot:1
+10 SET VAF326=$PIECE(VAF32N,U,6)
SET VAF326=$SELECT(VAF326:$$HLDATE^HLFNC(VAF326),1:VAFHLQ)
+11 SET VAF327=$PIECE(VAF32N,U,7)
SET VAF327=$SELECT(VAF327:$$HLDATE^HLFNC(VAF327),1:VAFHLQ)
+12 ; Service entry date~Service separation date
+13 SET $PIECE(VAFY,VAFHLS,4)=VAF326_$EXTRACT(VAFHLC)_VAF327
End DoDot:1
+14 IF VAFSTR[",5,"
Begin DoDot:1
+15 ; Service Component [L]
+16 SET VAFSCL=$PIECE(VAF3291N,U,1)
IF VAFSCL=""
SET VAFSCL=VAFHLQ
+17 SET $PIECE(VAFY,VAFHLS,5)=VAFSCL
End DoDot:1
+18 QUIT
SNL ; next to last Service branch
+1 SET $PIECE(VAFY,VAFHLS,2)="SNL"
+2 NEW VAF3291,VAF3294,VAF329,VAF3292,VAF3293,VAFSCNL
+3 IF VAFSTR[",3,"
Begin DoDot:1
+4 SET VAF3291=$PIECE(VAF32N,U,10)
SET VAF3291=$SELECT(VAF3291:$PIECE($GET(^DIC(23,VAF3291,0)),U),1:VAFHLQ)
+5 SET VAF3294=$PIECE(VAF32N,U,13)
IF VAF3294=""
SET VAF3294=VAFHLQ
+6 SET VAF329=$PIECE(VAF32N,U,9)
SET VAF329=$SELECT(VAF329:$PIECE($GET(^DIC(25,VAF329,0)),U),1:VAFHLQ)
+7 SET $PIECE(VAFY,VAFHLS,3)=VAF3291_$EXTRACT(VAFHLC)_VAF3294_$EXTRACT(VAFHLC)_VAF329
End DoDot:1
+8 IF VAFSTR[",4,"
Begin DoDot:1
+9 SET VAF3292=$PIECE(VAF32N,U,11)
SET VAF3292=$SELECT(VAF3292:$$HLDATE^HLFNC(VAF3292),1:VAFHLQ)
+10 SET VAF3293=$PIECE(VAF32N,U,12)
SET VAF3293=$SELECT(VAF3293:$$HLDATE^HLFNC(VAF3293),1:VAFHLQ)
+11 SET $PIECE(VAFY,VAFHLS,4)=VAF3292_$EXTRACT(VAFHLC)_VAF3293
End DoDot:1
+12 IF VAFSTR[",5,"
Begin DoDot:1
+13 ; Service Component [NL]
+14 SET VAFSCNL=$PIECE(VAF3291N,U,2)
IF VAFSCNL=""
SET VAFSCNL=VAFHLQ
+15 SET $PIECE(VAFY,VAFHLS,5)=VAFSCNL
End DoDot:1
+16 QUIT
SNNL ; next to next to last Service branch
+1 SET $PIECE(VAFY,VAFHLS,2)="SNNL"
+2 NEW VAF3296,VAF3299,VAF3295,VAF3297,VAF3298,VAFSCNNL
+3 IF VAFSTR[",3,"
Begin DoDot:1
+4 SET VAF3296=$PIECE(VAF32N,U,15)
SET VAF3296=$SELECT(VAF3296:$PIECE($GET(^DIC(23,VAF3296,0)),U),1:VAFHLQ)
+5 SET VAF3299=$PIECE(VAF32N,U,18)
IF VAF3299=""
SET VAF3299=VAFHLQ
+6 SET VAF3295=$PIECE(VAF32N,U,14)
SET VAF3295=$SELECT(VAF3295:$PIECE($GET(^DIC(25,VAF3295,0)),U),1:VAFHLQ)
+7 SET $PIECE(VAFY,VAFHLS,3)=VAF3296_$EXTRACT(VAFHLC)_VAF3299_$EXTRACT(VAFHLC)_VAF3295
End DoDot:1
+8 IF VAFSTR[",4,"
Begin DoDot:1
+9 SET VAF3297=$PIECE(VAF32N,U,16)
SET VAF3297=$SELECT(VAF3297:$$HLDATE^HLFNC(VAF3297),1:VAFHLQ)
+10 SET VAF3298=$PIECE(VAF32N,U,17)
SET VAF3298=$SELECT(VAF3298:$$HLDATE^HLFNC(VAF3298),1:VAFHLQ)
+11 SET $PIECE(VAFY,VAFHLS,4)=VAF3297_$EXTRACT(VAFHLC)_VAF3298
End DoDot:1
+12 IF VAFSTR[",5,"
Begin DoDot:1
+13 ; Service Component [NNL]
+14 SET VAFSCNNL=$PIECE(VAF3291N,U,3)
IF VAFSCNNL=""
SET VAFSCNNL=VAFHLQ
+15 SET $PIECE(VAFY,VAFHLS,5)=VAFSCNNL
End DoDot:1
+16 QUIT
POW ; Prisoner of War
+1 SET $PIECE(VAFY,VAFHLS,2)="POW"
+2 NEW VAF525,VAF526,VAF527,VAF528
+3 IF VAFSTR[",3,"
Begin DoDot:1
+4 SET VAF525=$PIECE(VAF52N,U,5)
IF VAF525=""
SET VAF525=VAFHLQ
+5 ;S VAF526=$P(VAF52N,U,6) S VAF526=$S(VAF526:$P($G(^DIC(22,VAF526,0)),U),1:VAFHLQ)
+6 ; translate pointer to coded value for VA0023 table
+7 SET VAF526=$PIECE(VAF52N,U,6)
SET VAF526=$SELECT(VAF526>0&(VAF526<7):VAF526+3,VAF526>6&(VAF526<9):$CHAR(VAF526+58),1:VAFHLQ)
+8 SET $PIECE(VAFY,VAFHLS,3)=VAF525_$EXTRACT(VAFHLC)_VAF526
End DoDot:1
+9 IF VAFSTR[",4,"
Begin DoDot:1
+10 SET VAF527=$PIECE(VAF52N,U,7)
SET VAF527=$SELECT(VAF527:$$HLDATE^HLFNC(VAF527),1:VAFHLQ)
+11 SET VAF528=$PIECE(VAF52N,U,8)
SET VAF528=$SELECT(VAF528:$$HLDATE^HLFNC(VAF528),1:VAFHLQ)
+12 SET $PIECE(VAFY,VAFHLS,4)=VAF527_$EXTRACT(VAFHLC)_VAF528
End DoDot:1
+13 IF VAFSTR[",5,"
SET $PIECE(VAFY,VAFHLS,5)=VAFHLQ
+14 QUIT
COMB ; Combat
+1 SET $PIECE(VAFY,VAFHLS,2)="COMB"
+2 NEW VAF5291,VAF5292,VAF5293,VAF5294
+3 IF VAFSTR[",3,"
Begin DoDot:1
+4 SET VAF5291=$PIECE(VAF52N,U,11)
IF VAF5291=""
SET VAF5291=VAFHLQ
+5 SET VAF5292=$PIECE(VAF52N,U,12)
SET VAF5292=$SELECT(VAF5292:$PIECE($GET(^DIC(22,VAF5292,0)),U),1:VAFHLQ)
+6 SET $PIECE(VAFY,VAFHLS,3)=VAF5291_$EXTRACT(VAFHLC)_VAF5292
End DoDot:1
+7 IF VAFSTR[",4,"
Begin DoDot:1
+8 SET VAF5293=$PIECE(VAF52N,U,13)
SET VAF5293=$SELECT(VAF5293:$$HLDATE^HLFNC(VAF5293),1:VAFHLQ)
+9 SET VAF5294=$PIECE(VAF52N,U,14)
SET VAF5294=$SELECT(VAF5294:$$HLDATE^HLFNC(VAF5294),1:VAFHLQ)
+10 SET $PIECE(VAFY,VAFHLS,4)=VAF5293_$EXTRACT(VAFHLC)_VAF5294
End DoDot:1
+11 IF VAFSTR[",5,"
SET $PIECE(VAFY,VAFHLS,5)=VAFHLQ
+12 QUIT
VIET ; Vietnam
+1 SET $PIECE(VAFY,VAFHLS,2)="VIET"
+2 NEW VAF32101,VAF32104,VAF32105
+3 IF VAFSTR[",3,"
Begin DoDot:1
+4 SET VAF32101=$PIECE(VAF321N,U)
IF VAF32101=""
SET VAF32101=VAFHLQ
+5 SET $PIECE(VAFY,VAFHLS,3)=VAF32101
End DoDot:1
+6 IF VAFSTR[",4,"
Begin DoDot:1
+7 SET VAF32104=$PIECE(VAF321N,U,4)
SET VAF32104=$SELECT(VAF32104:$$HLDATE^HLFNC(VAF32104),1:VAFHLQ)
+8 SET VAF32105=$PIECE(VAF321N,U,5)
SET VAF32105=$SELECT(VAF32105:$$HLDATE^HLFNC(VAF32105),1:VAFHLQ)
+9 SET $PIECE(VAFY,VAFHLS,4)=VAF32104_$EXTRACT(VAFHLC)_VAF32105
End DoDot:1
+10 IF VAFSTR[",5,"
SET $PIECE(VAFY,VAFHLS,5)=VAFHLQ
+11 QUIT
LEBA ; Lebanon
+1 SET $PIECE(VAFY,VAFHLS,2)="LEBA"
+2 NEW VAF3221,VAF3222,VAF3223
+3 IF VAFSTR[",3,"
Begin DoDot:1
+4 SET VAF3221=$PIECE(VAF322N,U)
IF VAF3221=""
SET VAF3221=VAFHLQ
+5 SET $PIECE(VAFY,VAFHLS,3)=VAF3221
End DoDot:1
+6 IF VAFSTR[",4,"
Begin DoDot:1
+7 SET VAF3222=$PIECE(VAF322N,U,2)
SET VAF3222=$SELECT(VAF3222:$$HLDATE^HLFNC(VAF3222),1:VAFHLQ)
+8 SET VAF3223=$PIECE(VAF322N,U,3)
SET VAF3223=$SELECT(VAF3223:$$HLDATE^HLFNC(VAF3223),1:VAFHLQ)
+9 SET $PIECE(VAFY,VAFHLS,4)=VAF3222_$EXTRACT(VAFHLC)_VAF3223
End DoDot:1
+10 IF VAFSTR[",5,"
SET $PIECE(VAFY,VAFHLS,5)=VAFHLQ
+11 QUIT
GREN ; Grenada
+1 SET $PIECE(VAFY,VAFHLS,2)="GREN"
+2 NEW VAF3224,VAF3225,VAF3226
+3 IF VAFSTR[",3,"
Begin DoDot:1
+4 SET VAF3224=$PIECE(VAF322N,U,4)
IF VAF3224=""
SET VAF3224=VAFHLQ
+5 SET $PIECE(VAFY,VAFHLS,3)=VAF3224
End DoDot:1
+6 IF VAFSTR[",4,"
Begin DoDot:1
+7 SET VAF3225=$PIECE(VAF322N,U,5)
SET VAF3225=$SELECT(VAF3225:$$HLDATE^HLFNC(VAF3225),1:VAFHLQ)
+8 SET VAF3226=$PIECE(VAF322N,U,6)
SET VAF3226=$SELECT(VAF3226:$$HLDATE^HLFNC(VAF3226),1:VAFHLQ)
+9 SET $PIECE(VAFY,VAFHLS,4)=VAF3225_$EXTRACT(VAFHLC)_VAF3226
End DoDot:1
+10 IF VAFSTR[",5,"
SET $PIECE(VAFY,VAFHLS,5)=VAFHLQ
+11 QUIT
PANA ; Panama
+1 SET $PIECE(VAFY,VAFHLS,2)="PANA"
+2 NEW VAF3227,VAF3228,VAF3229
+3 IF VAFSTR[",3,"
Begin DoDot:1
+4 SET VAF3227=$PIECE(VAF322N,U,7)
IF VAF3227=""
SET VAF3227=VAFHLQ
+5 SET $PIECE(VAFY,VAFHLS,3)=VAF3227
End DoDot:1
+6 IF VAFSTR[",4,"
Begin DoDot:1
+7 SET VAF3228=$PIECE(VAF322N,U,8)
SET VAF3228=$SELECT(VAF3228:$$HLDATE^HLFNC(VAF3228),1:VAFHLQ)
+8 SET VAF3229=$PIECE(VAF322N,U,9)
SET VAF3229=$SELECT(VAF3229:$$HLDATE^HLFNC(VAF3229),1:VAFHLQ)
+9 SET $PIECE(VAFY,VAFHLS,4)=VAF3228_$EXTRACT(VAFHLC)_VAF3229
End DoDot:1
+10 IF VAFSTR[",5,"
SET $PIECE(VAFY,VAFHLS,5)=VAFHLQ
+11 QUIT
GULF ; Persian Gulf
+1 SET $PIECE(VAFY,VAFHLS,2)="GULF"
+2 NEW VAF32201,VA322011,VA322012
+3 IF VAFSTR[",3,"
Begin DoDot:1
+4 SET VAF32201=$PIECE(VAF322N,U,10)
IF VAF32201=""
SET VAF32201=VAFHLQ
+5 SET $PIECE(VAFY,VAFHLS,3)=VAF32201
End DoDot:1
+6 IF VAFSTR[",4,"
Begin DoDot:1
+7 SET VA322011=$PIECE(VAF322N,U,11)
SET VA322011=$SELECT(VA322011:$$HLDATE^HLFNC(VA322011),1:VAFHLQ)
+8 SET VA322012=$PIECE(VAF322N,U,12)
SET VA322012=$SELECT(VA322012:$$HLDATE^HLFNC(VA322012),1:VAFHLQ)
+9 SET $PIECE(VAFY,VAFHLS,4)=VA322011_$EXTRACT(VAFHLC)_VA322012
End DoDot:1
+10 IF VAFSTR[",5,"
SET $PIECE(VAFY,VAFHLS,5)=VAFHLQ
+11 QUIT
SOMA ; Somalia
+1 SET $PIECE(VAFY,VAFHLS,2)="SOMA"
+2 NEW VA322016,VA322017,VA322018
+3 IF VAFSTR[",3,"
Begin DoDot:1
+4 SET VA322016=$PIECE(VAF322N,U,16)
IF VA322016=""
SET VA322016=VAFHLQ
+5 SET $PIECE(VAFY,VAFHLS,3)=VA322016
End DoDot:1
+6 IF VAFSTR[",4,"
Begin DoDot:1
+7 SET VA322017=$PIECE(VAF322N,U,17)
SET VA322017=$SELECT(VA322017:$$HLDATE^HLFNC(VA322017),1:VAFHLQ)
+8 SET VA322018=$PIECE(VAF322N,U,18)
SET VA322018=$SELECT(VA322018:$$HLDATE^HLFNC(VA322018),1:VAFHLQ)
+9 SET $PIECE(VAFY,VAFHLS,4)=VA322017_$EXTRACT(VAFHLC)_VA322018
End DoDot:1
+10 IF VAFSTR[",5,"
SET $PIECE(VAFY,VAFHLS,5)=VAFHLQ
+11 QUIT
YUGO ; Yugoslavia
+1 SET $PIECE(VAFY,VAFHLS,2)="YUGO"
+2 NEW VA322019,VA32202,VA322021
+3 IF VAFSTR[",3,"
Begin DoDot:1
+4 SET VA322019=$PIECE(VAF322N,U,19)
IF VA322019=""
SET VA322019=VAFHLQ
+5 SET $PIECE(VAFY,VAFHLS,3)=VA322019
End DoDot:1
+6 IF VAFSTR[",4,"
Begin DoDot:1
+7 SET VA32202=$PIECE(VAF322N,U,20)
SET VA32202=$SELECT(VA32202:$$HLDATE^HLFNC(VA32202),1:VAFHLQ)
+8 SET VA322021=$PIECE(VAF322N,U,21)
SET VA322021=$SELECT(VA322021:$$HLDATE^HLFNC(VA322021),1:VAFHLQ)
+9 SET $PIECE(VAFY,VAFHLS,4)=VA32202_$EXTRACT(VAFHLC)_VA322021
End DoDot:1
+10 IF VAFSTR[",5,"
SET $PIECE(VAFY,VAFHLS,5)=VAFHLQ
+11 QUIT
PH ; Purple Heart Recipent
+1 SET $PIECE(VAFY,VAFHLS,2)="PH"
+2 NEW VAF531,VAF532,VAF533
+3 IF VAFSTR[",3,"
Begin DoDot:1
+4 SET VAF531=$PIECE(VAF53N,U,1)
IF VAF531=""
SET VAF531=VAFHLQ
+5 SET VAF532=$PIECE(VAF53N,U,2)
IF VAF532=""
SET VAF532=VAFHLQ
+6 SET VAF533=$PIECE(VAF53N,U,3)
IF VAF533=""
SET VAF533=VAFHLQ
+7 SET $PIECE(VAFY,VAFHLS,3)=VAF531_$EXTRACT(VAFHLC)_VAF532_$EXTRACT(VAFHLC)_VAF533
End DoDot:1
+8 IF VAFSTR[",4,"
Begin DoDot:1
+9 SET $PIECE(VAFY,VAFHLS,4)=VAFHLQ
End DoDot:1
+10 IF VAFSTR[",5,"
SET $PIECE(VAFY,VAFHLS,5)=VAFHLQ
+11 QUIT
OEIF ;build Operation Enduring/Iraqi Freedom segments
+1 DO OEIF^VAFHLZM2
+2 QUIT
NOSEG ;
+1 DO NOSEG^VAFHLZM2
+2 QUIT
+3 ;
MSDS ;build new ZMH format for MSDS records
+1 DO MSDS^VAFHLZM2
+2 QUIT
