VAFHLZSP.m

VAFHLZSP ;ALB/RJS,TDM,PJH - ZSP SEGMENT - 3/18/96 ; 5/30/07 4:21pm

 ;;5.3;PIMS;**94,106,122,220,653,1015,1016**;JUN 30, 2012;Build 20

EN(DFN,VAFNUM,VAFAMB) ;

 N VAROOT,VAFHROOT,VAFY,VAFNODE,VIETSRV,SERVCONN,PERCENT,POS,RETURN

 S VAROOT="VAFHROOT"

 D ELIG^VADPT

 ;- ALB/ESD - Added VAFNUM as part of Ambulatory Care Reporting Project

 ;            requirements.

 S VAFNUM=$S($G(VAFNUM):VAFNUM,1:1)

 S VAFAMB=+$G(VAFAMB,1)

 I $P(VAFHROOT(3),U,1)=1 S SERVCONN="Y",PERCENT=$P(VAFHROOT(3),U,2)

 I $P(VAFHROOT(3),U,1)=0 S SERVCONN="N"

 I VAFHROOT(2)'="" S POS=$P($G(^DIC(21,+VAFHROOT(2),0)),U,3)

 I '$D(SERVCONN) S SERVCONN=""""""

 I '$D(PERCENT) S PERCENT=""""""

 I '$D(POS) S POS=""""""

 ;

 ;- Convert Y/N to 1/0 (HL7 Table VA01)

 I $D(SERVCONN) S SERVCONN=$$YN^VAFHLFNC(SERVCONN)

 S RETURN="ZSP"_HLFS_VAFNUM_HLFS_SERVCONN_HLFS_PERCENT_HLFS_POS

 ;- ALB/ESD - Get 'Vietnam Service Indicated?' field from PATIENT file

 ;            (required by Ambulatory Care Reporting Project).

 ;I +$G(VAFAMB)=1 D

 ;. ;

 ;. ;- 'Vietnam Service Indicated?' field = Y, N, or U (UNKNOWN)

 ;. S VIETSRV=$P($G(^DPT(DFN,.321)),"^")

 ;. I $G(VIETSRV)="" S VIETSRV=""""""

 ;. S RETURN=RETURN_HLFS_VIETSRV

 ;

 ;- DG*5.3*220 REMOVED CHECK FOR VAFAMB PARAMETER

 ;'Vietnam Service Indicated?' field = Y, N, or U (UNKNOWN)

 S VIETSRV=$P($G(^DPT(DFN,.321)),"^")

 I $G(VIETSRV)="" S VIETSRV=""""""

 S RETURN=RETURN_HLFS_VIETSRV

 ;

 ; **** ALB/KCL - Patch DG*5.3*122; Add additional data fields ****

 S VAFNODE=$G(^DPT(DFN,.3))

 S $P(VAFY,HLFS,3)="",HLQ=$S($D(HLQ):HLQ,1:"""""")

 S $P(VAFY,HLFS,1)=$S($P(VAFNODE,"^",4)]"":$$YN^VAFHLFNC($P(VAFNODE,"^",4)),1:HLQ) ; P&T

 S $P(VAFY,HLFS,2)=$S($P(VAFNODE,"^",5)]"":$$YN^VAFHLFNC($P(VAFNODE,"^",5)),1:HLQ) ; Unemployable

 S $P(VAFY,HLFS,3)=$S($P(VAFNODE,"^",12)]"":$$HLDATE^HLFNC($P(VAFNODE,"^",12)),1:HLQ) ; SC Award Date

 S $P(VAFY,HLFS,5)=$S($P(VAFNODE,"^",13)]"":$$HLDATE^HLFNC($P(VAFNODE,"^",13)),1:HLQ) ; P&T Effective Date

 ; **** PJH - Patch DG*5.3*754; Add additional data field ****

 S $P(VAFY,HLFS,6)=$S($P(VAFNODE,"^",14)]"":$$HLDATE^HLFNC($P(VAFNODE,"^",14)),1:HLQ) ; Combined SC percent Effective Date

 ;

 S RETURN=RETURN_HLFS_$G(VAFY)

 ;

 ;

 D KVAR^VADPT

 Q RETURN

VAFHLZSP  ;ALB/RJS,TDM,PJH - ZSP SEGMENT - 3/18/96 ; 5/30/07 4:21pm

 +1       ;;5.3;PIMS;**94,106,122,220,653,1015,1016**;JUN 30, 2012;Build 20

EN(DFN,VAFNUM,VAFAMB) ;

 +1        NEW VAROOT,VAFHROOT,VAFY,VAFNODE,VIETSRV,SERVCONN,PERCENT,POS,RETURN

 +2        SET VAROOT="VAFHROOT"

 +3        DO ELIG^VADPT

 +4       ;- ALB/ESD - Added VAFNUM as part of Ambulatory Care Reporting Project

 +5       ;            requirements.

 +6        SET VAFNUM=$SELECT($GET(VAFNUM):VAFNUM,1:1)

 +7        SET VAFAMB=+$GET(VAFAMB,1)

 +8        IF $PIECE(VAFHROOT(3),U,1)=1

               SET SERVCONN="Y"

               SET PERCENT=$PIECE(VAFHROOT(3),U,2)

 +9        IF $PIECE(VAFHROOT(3),U,1)=0

               SET SERVCONN="N"

 +10       IF VAFHROOT(2)'=""

               SET POS=$PIECE($GET(^DIC(21,+VAFHROOT(2),0)),U,3)

 +11       IF '$DATA(SERVCONN)

               SET SERVCONN=""""""

 +12       IF '$DATA(PERCENT)

               SET PERCENT=""""""

 +13       IF '$DATA(POS)

               SET POS=""""""

 +14      ;

 +15      ;- Convert Y/N to 1/0 (HL7 Table VA01)

 +16       IF $DATA(SERVCONN)

               SET SERVCONN=$$YN^VAFHLFNC(SERVCONN)

 +17       SET RETURN="ZSP"_HLFS_VAFNUM_HLFS_SERVCONN_HLFS_PERCENT_HLFS_POS

 +18      ;- ALB/ESD - Get 'Vietnam Service Indicated?' field from PATIENT file

 +19      ;            (required by Ambulatory Care Reporting Project).

 +20      ;I +$G(VAFAMB)=1 D

 +21      ;. ;

 +22      ;. ;- 'Vietnam Service Indicated?' field = Y, N, or U (UNKNOWN)

 +23      ;. S VIETSRV=$P($G(^DPT(DFN,.321)),"^")

 +24      ;. I $G(VIETSRV)="" S VIETSRV=""""""

 +25      ;. S RETURN=RETURN_HLFS_VIETSRV

 +26      ;

 +27      ;- DG*5.3*220 REMOVED CHECK FOR VAFAMB PARAMETER

 +28      ;'Vietnam Service Indicated?' field = Y, N, or U (UNKNOWN)

 +29       SET VIETSRV=$PIECE($GET(^DPT(DFN,.321)),"^")

 +30       IF $GET(VIETSRV)=""

               SET VIETSRV=""""""

 +31       SET RETURN=RETURN_HLFS_VIETSRV

 +32      ;

 +33      ; **** ALB/KCL - Patch DG*5.3*122; Add additional data fields ****

 +34       SET VAFNODE=$GET(^DPT(DFN,.3))

 +35       SET $PIECE(VAFY,HLFS,3)=""

           SET HLQ=$SELECT($DATA(HLQ):HLQ,1:"""""")

 +36      ; P&T

           SET $PIECE(VAFY,HLFS,1)=$SELECT($PIECE(VAFNODE,"^",4)]"":$$YN^VAFHLFNC($PIECE(VAFNODE,"^",4)),1:HLQ)

 +37      ; Unemployable

           SET $PIECE(VAFY,HLFS,2)=$SELECT($PIECE(VAFNODE,"^",5)]"":$$YN^VAFHLFNC($PIECE(VAFNODE,"^",5)),1:HLQ)

 +38      ; SC Award Date

           SET $PIECE(VAFY,HLFS,3)=$SELECT($PIECE(VAFNODE,"^",12)]"":$$HLDATE^HLFNC($PIECE(VAFNODE,"^",12)),1:HLQ)

 +39      ; P&T Effective Date

           SET $PIECE(VAFY,HLFS,5)=$SELECT($PIECE(VAFNODE,"^",13)]"":$$HLDATE^HLFNC($PIECE(VAFNODE,"^",13)),1:HLQ)

 +40      ; **** PJH - Patch DG*5.3*754; Add additional data field ****

 +41      ; Combined SC percent Effective Date

           SET $PIECE(VAFY,HLFS,6)=$SELECT($PIECE(VAFNODE,"^",14)]"":$$HLDATE^HLFNC($PIECE(VAFNODE,"^",14)),1:HLQ)

 +42      ;

 +43       SET RETURN=RETURN_HLFS_$GET(VAFY)

 +44      ;

 +45      ;

 +46       DO KVAR^VADPT

 +47       QUIT RETURN