VAFHLZSP ;ALB/RJS,TDM,PJH - ZSP SEGMENT - 3/18/96 ; 5/30/07 4:21pm
;;5.3;Registration;**94,106,122,220,653,754**;Aug 13, 1993;Build 46
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
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HVAFHLZSP 2242 printed Apr 09, 2024@21:48:33 Page 2
VAFHLZSP ;ALB/RJS,TDM,PJH - ZSP SEGMENT - 3/18/96 ; 5/30/07 4:21pm
+1 ;;5.3;Registration;**94,106,122,220,653,754**;Aug 13, 1993;Build 46
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
