VAFHLZM2.m

VAFHLZM2 ;ALB/KCL - Create HL7 Military History segment (ZMH) Cont ; 1/26/06

 ;;5.3;Registration;**673,1015**;Aug 13, 1993;Build 21

 ;

 ;--------------------------------------------------------------------------------

 ;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

VAFHLZM2  ;ALB/KCL - Create HL7 Military History segment (ZMH) Cont ; 1/26/06

 +1       ;;5.3;Registration;**673,1015**;Aug 13, 1993;Build 21

 +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