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

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

initial load of WorldVistAEHR

File size: 2.8 KB
Line 
1VAFHLZBT ;ALB/KCL - CREATE HL7 BENEFICIARY TRAVEL (ZBT) SEGMENT ; 12-SEPTEMBER-1997
2 ;;5.3;Registration;**122**;Aug 13, 1993
3 ;
4 ;
5 ; This generic extrinsic function is designed to return the HL7
6 ; Beneficiary Travel (ZBT) segment. This segment contains VA-
7 ; specific Beneficiary Travel data for a selected patient.
8 ;
9 ;
10EN(VAFDATE,VAFSTR,VAFHLQ,VAFHLFS) ; --
11 ; Entry point for creating HL7 ZBT segment
12 ;
13 ; Input(s):
14 ; VAFDATE - internal entry number of Bene Travel Claim (#392) file
15 ; VAFSTR - (optional) string of fields requested, separated by
16 ; commas. If not passed, return all data fields.
17 ; VAFHLQ - (optional) HL7 null variable.
18 ; VAFHLFS - (optional) HL7 field separator.
19 ;
20 ; Output:
21 ; String containing the desired components of the HL7 ZBT segment
22 ;
23 ;
24 N VAFANOD,VAFCERT,VAFCLM,VAFMTS,VAFY,X,Y
25 ;
26 ; if VAFHLQ or VAFHLFS not passed, use default HL7 variables
27 S VAFHLQ=$S($D(VAFHLQ):VAFHLQ,1:$G(HLQ)),VAFHLFS=$S($D(VAFHLFS):VAFHLFS,1:$G(HLFS))
28 ;
29 ; if VAFDATE not passed, exit
30 I '$G(VAFDATE) S VAFY=1 G ENQ
31 ;
32 ; zero node from BENE TRAVEL CLAIM (#392) file
33 S VAFCLM=$G(^DGBT(392,VAFDATE,0))
34 ; convert 5th piece to pointer value
35 S Y=0,X=$P(VAFCLM,"^",5) I X'="" D ^%DT S X=9999999-Y
36 ;
37 ; zero & 'A' node from BENE TRAVEL CERT. (#392.2) file
38 S VAFCERT=$G(^DGBT(392.2,+$O(^DGBT(392.2,"C",+$P(VAFCLM,"^",2),+X)),0)),VAFANOD=$G(^("A"))
39 I VAFCERT="" S VAFCERT=$G(^DGBT(392.2,+$O(^DGBT(392.2,"C",+$P(VAFCLM,"^",2),0)),0)),VAFANOD=$G(^("A"))
40 ;
41 ; if no certificate, exit
42 I VAFCERT="" S VAFY=1 G ENQ
43 ;
44 ; if VAFSTR not passed, return all data fields
45 I $G(VAFSTR)']"" S VAFSTR="2,3,4,5,6,7"
46 S $P(VAFY,VAFHLFS,8)="",VAFSTR=","_VAFSTR_","
47 ;
48 S $P(VAFY,VAFHLFS,1)=1 ; Set Id - always 1
49 I VAFSTR[",2," S $P(VAFY,VAFHLFS,2)=$S($P(VAFCERT,"^",1)]"":$$HLDATE^HLFNC($P(VAFCERT,"^",1)),1:VAFHLQ) ; Date Certified
50 I VAFSTR[",3," S X=$$YN^VAFHLFNC($P(VAFCERT,"^",3)),$P(VAFY,VAFHLFS,3)=$S(X]"":X,1:VAFHLQ) ; Eligible
51 I VAFSTR[",4," S $P(VAFY,VAFHLFS,4)=$S($P(VAFCERT,"^",4)]"":$P(VAFCERT,"^",4),1:VAFHLQ) ; Amount Certified (amount of income reported)
52 ;
53 I VAFSTR[",5," D
54 .I $P(VAFANOD,"^",8)]"" D
55 ..S VAFMTS=$P(VAFANOD,"^",8)
56 ..I $L(VAFMTS)>1 S VAFMTS=$TR(VAFMTS," ","")
57 ..I $L(VAFMTS)<1 S VAFMTST="" Q
58 ..S VAFMTST=+$O(^DG(408.32,"C",VAFMTS,0)),VAFMTST=$G(^DG(408.32,+VAFMTST,0)),VAFMTST=$P(VAFMTST,"^",2)
59 .S $P(VAFY,VAFHLFS,5)=$S($G(VAFMTST)]"":VAFMTST,1:VAFHLQ) ; Means Test Status
60 ;
61 I VAFSTR[",6," D
62 .I $P(VAFANOD,"^",9)]"" D
63 ..S VAFELIG=+$O(^DIC(8,"B",$P(VAFANOD,"^",9),0)),VAFELIG=$P($G(^DIC(8,VAFELIG,0)),"^",9)
64 .S $P(VAFY,VAFHLFS,6)=$S(+$G(VAFELIG)>0:VAFELIG,1:VAFHLQ) ; Primary Eligibility Code
65 ;
66 I VAFSTR[",7," S $P(VAFY,VAFHLFS,7)=$S($P(VAFCLM,"^",1)]"":$$HLDATE^HLFNC($P(VAFCLM,"^",1)),1:VAFHLQ) ; Claim Date
67 ;
68ENQ Q "ZBT"_VAFHLFS_$G(VAFY)
Note: See TracBrowser for help on using the repository browser.