Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: VAFHLZSP

VAFHLZSP.m

Go to the documentation of this file.
  1. 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
  1. EN(DFN,VAFNUM,VAFAMB) ;
  1. N VAROOT,VAFHROOT,VAFY,VAFNODE,VIETSRV,SERVCONN,PERCENT,POS,RETURN
  1. S VAROOT="VAFHROOT"
  1. D ELIG^VADPT
  1. ;- ALB/ESD - Added VAFNUM as part of Ambulatory Care Reporting Project
  1. ; requirements.
  1. S VAFNUM=$S($G(VAFNUM):VAFNUM,1:1)
  1. S VAFAMB=+$G(VAFAMB,1)
  1. I $P(VAFHROOT(3),U,1)=1 S SERVCONN="Y",PERCENT=$P(VAFHROOT(3),U,2)
  1. I $P(VAFHROOT(3),U,1)=0 S SERVCONN="N"
  1. I VAFHROOT(2)'="" S POS=$P($G(^DIC(21,+VAFHROOT(2),0)),U,3)
  1. I '$D(SERVCONN) S SERVCONN=""""""
  1. I '$D(PERCENT) S PERCENT=""""""
  1. I '$D(POS) S POS=""""""
  1. ;
  1. ;- Convert Y/N to 1/0 (HL7 Table VA01)
  1. I $D(SERVCONN) S SERVCONN=$$YN^VAFHLFNC(SERVCONN)
  1. S RETURN="ZSP"_HLFS_VAFNUM_HLFS_SERVCONN_HLFS_PERCENT_HLFS_POS
  1. ;- ALB/ESD - Get 'Vietnam Service Indicated?' field from PATIENT file
  1. ; (required by Ambulatory Care Reporting Project).
  1. ;I +$G(VAFAMB)=1 D
  1. ;. ;
  1. ;. ;- 'Vietnam Service Indicated?' field = Y, N, or U (UNKNOWN)
  1. ;. S VIETSRV=$P($G(^DPT(DFN,.321)),"^")
  1. ;. I $G(VIETSRV)="" S VIETSRV=""""""
  1. ;. S RETURN=RETURN_HLFS_VIETSRV
  1. ;
  1. ;- DG*5.3*220 REMOVED CHECK FOR VAFAMB PARAMETER
  1. ;'Vietnam Service Indicated?' field = Y, N, or U (UNKNOWN)
  1. S VIETSRV=$P($G(^DPT(DFN,.321)),"^")
  1. I $G(VIETSRV)="" S VIETSRV=""""""
  1. S RETURN=RETURN_HLFS_VIETSRV
  1. ;
  1. ; **** ALB/KCL - Patch DG*5.3*122; Add additional data fields ****
  1. S VAFNODE=$G(^DPT(DFN,.3))
  1. S $P(VAFY,HLFS,3)="",HLQ=$S($D(HLQ):HLQ,1:"""""")
  1. S $P(VAFY,HLFS,1)=$S($P(VAFNODE,"^",4)]"":$$YN^VAFHLFNC($P(VAFNODE,"^",4)),1:HLQ) ; P&T
  1. S $P(VAFY,HLFS,2)=$S($P(VAFNODE,"^",5)]"":$$YN^VAFHLFNC($P(VAFNODE,"^",5)),1:HLQ) ; Unemployable
  1. S $P(VAFY,HLFS,3)=$S($P(VAFNODE,"^",12)]"":$$HLDATE^HLFNC($P(VAFNODE,"^",12)),1:HLQ) ; SC Award Date
  1. S $P(VAFY,HLFS,5)=$S($P(VAFNODE,"^",13)]"":$$HLDATE^HLFNC($P(VAFNODE,"^",13)),1:HLQ) ; P&T Effective Date
  1. ; **** PJH - Patch DG*5.3*754; Add additional data field ****
  1. S $P(VAFY,HLFS,6)=$S($P(VAFNODE,"^",14)]"":$$HLDATE^HLFNC($P(VAFNODE,"^",14)),1:HLQ) ; Combined SC percent Effective Date
  1. ;
  1. S RETURN=RETURN_HLFS_$G(VAFY)
  1. ;
  1. ;
  1. D KVAR^VADPT
  1. Q RETURN