VAFHLZM1.m

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 ---VAFHLZM1   9061     printed  Mar 13, 2025@22:08:13                                                                                                                                                                                                    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