source: WorldVistAEHR/trunk/r/REGISTRATION-DGQE-DG-DPT-GRPX-VAD-VAF-VAS-VAT-VAU--VA-VIC--DGBT--DGJ--DGYA--VALM/VAFHLZSP.m@ 1697

Last change on this file since 1697 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 2.0 KB
RevLine 
[613]1VAFHLZSP ;ALB/RJS,TDM - ZSP SEGMENT - 3/18/96 ; 9/19/05 11:50am
2 ;;5.3;Registration;**94,106,122,220,653**;Aug 13, 1993;Build 2
3EN(DFN,VAFNUM,VAFAMB) ;
4 N VAROOT,VAFHROOT,VAFY,VAFNODE,VIETSRV,SERVCONN,PERCENT,POS,RETURN
5 S VAROOT="VAFHROOT"
6 D ELIG^VADPT
7 ;- ALB/ESD - Added VAFNUM as part of Ambulatory Care Reporting Project
8 ; requirements.
9 S VAFNUM=$S($G(VAFNUM):VAFNUM,1:1)
10 S VAFAMB=+$G(VAFAMB,1)
11 I $P(VAFHROOT(3),U,1)=1 S SERVCONN="Y",PERCENT=$P(VAFHROOT(3),U,2)
12 I $P(VAFHROOT(3),U,1)=0 S SERVCONN="N"
13 I VAFHROOT(2)'="" S POS=$P($G(^DIC(21,+VAFHROOT(2),0)),U,3)
14 I '$D(SERVCONN) S SERVCONN=""""""
15 I '$D(PERCENT) S PERCENT=""""""
16 I '$D(POS) S POS=""""""
17 ;
18 ;- Convert Y/N to 1/0 (HL7 Table VA01)
19 I $D(SERVCONN) S SERVCONN=$$YN^VAFHLFNC(SERVCONN)
20 S RETURN="ZSP"_HLFS_VAFNUM_HLFS_SERVCONN_HLFS_PERCENT_HLFS_POS
21 ;- ALB/ESD - Get 'Vietnam Service Indicated?' field from PATIENT file
22 ; (required by Ambulatory Care Reporting Project).
23 ;I +$G(VAFAMB)=1 D
24 ;. ;
25 ;. ;- 'Vietnam Service Indicated?' field = Y, N, or U (UNKNOWN)
26 ;. S VIETSRV=$P($G(^DPT(DFN,.321)),"^")
27 ;. I $G(VIETSRV)="" S VIETSRV=""""""
28 ;. S RETURN=RETURN_HLFS_VIETSRV
29 ;
30 ;- DG*5.3*220 REMOVED CHECK FOR VAFAMB PARAMETER
31 ;'Vietnam Service Indicated?' field = Y, N, or U (UNKNOWN)
32 S VIETSRV=$P($G(^DPT(DFN,.321)),"^")
33 I $G(VIETSRV)="" S VIETSRV=""""""
34 S RETURN=RETURN_HLFS_VIETSRV
35 ;
36 ; **** ALB/KCL - Patch DG*5.3*122; Add additional data fields ****
37 S VAFNODE=$G(^DPT(DFN,.3))
38 S $P(VAFY,HLFS,3)="",HLQ=$S($D(HLQ):HLQ,1:"""""")
39 S $P(VAFY,HLFS,1)=$S($P(VAFNODE,"^",4)]"":$$YN^VAFHLFNC($P(VAFNODE,"^",4)),1:HLQ) ; P&T
40 S $P(VAFY,HLFS,2)=$S($P(VAFNODE,"^",5)]"":$$YN^VAFHLFNC($P(VAFNODE,"^",5)),1:HLQ) ; Unemployable
41 S $P(VAFY,HLFS,3)=$S($P(VAFNODE,"^",12)]"":$$HLDATE^HLFNC($P(VAFNODE,"^",12)),1:HLQ) ; SC Award Date
42 S $P(VAFY,HLFS,5)=$S($P(VAFNODE,"^",13)]"":$$HLDATE^HLFNC($P(VAFNODE,"^",13)),1:HLQ) ; P&T Effective Date
43 ;
44 S RETURN=RETURN_HLFS_$G(VAFY)
45 ;
46 ;
47 D KVAR^VADPT
48 Q RETURN
Note: See TracBrowser for help on using the repository browser.