- 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 Jan 18, 2025@04:04:21 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