VAFHLZBT ;ALB/KCL,CKN - CREATE HL7 BENEFICIARY TRAVEL (ZBT) SEGMENT ; 12/6/06 3:25pm
;;5.3;Registration;**122,688**;Aug 13, 1993;Build 29
;
;
; This generic extrinsic function is designed to return the HL7
; Beneficiary Travel (ZBT) segment. This segment contains VA-
; specific Beneficiary Travel data for a selected patient.
;
;
EN(VAFDATE,VAFSTR,VAFHLQ,VAFHLFS) ; --
; Entry point for creating HL7 ZBT segment
;
; Input(s):
; VAFDATE - internal entry number of Bene Travel Claim (#392) file
; VAFSTR - (optional) string of fields requested, separated by
; commas. If not passed, return all data fields.
; VAFHLQ - (optional) HL7 null variable.
; VAFHLFS - (optional) HL7 field separator.
;
; Output:
; String containing the desired components of the HL7 ZBT segment
;
;
N VAFANOD,VAFCERT,VAFCLM,VAFMTS,VAFY,X,Y
;
; if VAFHLQ or VAFHLFS not passed, use default HL7 variables
S VAFHLQ=$S($D(VAFHLQ):VAFHLQ,1:$G(HLQ)),VAFHLFS=$S($D(VAFHLFS):VAFHLFS,1:$G(HLFS))
;
;If VAFDATE not passed, populate all valid seq. with ""(dbl quotes)
I '$G(VAFDATE) D G ENQ
. S VAFY=1
. I $G(VAFSTR) F I=2:1:$L(VAFSTR,",") S $P(VAFY,VAFHLFS,$P(VAFSTR,",",I))=VAFHLQ
. E F I=2:1:7 S $P(VAFY,VAFHLFS,I)=VAFHLQ
;
; zero node from BENE TRAVEL CLAIM (#392) file
S VAFCLM=$G(^DGBT(392,VAFDATE,0))
; convert 5th piece to pointer value
S Y=0,X=$P(VAFCLM,"^",5) I X'="" D ^%DT S X=9999999-Y
;
; zero & 'A' node from BENE TRAVEL CERT. (#392.2) file
S VAFCERT=$G(^DGBT(392.2,+$O(^DGBT(392.2,"C",+$P(VAFCLM,"^",2),+X)),0)),VAFANOD=$G(^("A"))
I VAFCERT="" S VAFCERT=$G(^DGBT(392.2,+$O(^DGBT(392.2,"C",+$P(VAFCLM,"^",2),0)),0)),VAFANOD=$G(^("A"))
;
;If no certificate, populate all valid seq. with ""(dbl quotes)
I VAFCERT="" D G ENQ
. S VAFY=1
. I $G(VAFSTR) F I=2:1:$L(VAFSTR,",") S $P(VAFY,VAFHLFS,$P(VAFSTR,",",I))=VAFHLQ
. E F I=2:1:7 S $P(VAFY,VAFHLFS,I)=VAFHLQ
;
; if VAFSTR not passed, return all data fields
I $G(VAFSTR)']"" S VAFSTR="2,3,4,5,6,7"
S $P(VAFY,VAFHLFS,8)="",VAFSTR=","_VAFSTR_","
;
S $P(VAFY,VAFHLFS,1)=1 ; Set Id - always 1
I VAFSTR[",2," S $P(VAFY,VAFHLFS,2)=$S($P(VAFCERT,"^",1)]"":$$HLDATE^HLFNC($P(VAFCERT,"^",1)),1:VAFHLQ) ; Date Certified
I VAFSTR[",3," S X=$$YN^VAFHLFNC($P(VAFCERT,"^",3)),$P(VAFY,VAFHLFS,3)=$S(X]"":X,1:VAFHLQ) ; Eligible
I VAFSTR[",4," S $P(VAFY,VAFHLFS,4)=$S($P(VAFCERT,"^",4)]"":$P(VAFCERT,"^",4),1:VAFHLQ) ; Amount Certified (amount of income reported)
;
I VAFSTR[",5," D
.I $P(VAFANOD,"^",8)]"" D
..S VAFMTS=$P(VAFANOD,"^",8)
..I $L(VAFMTS)>1 S VAFMTS=$TR(VAFMTS," ","")
..I $L(VAFMTS)<1 S VAFMTST="" Q
..S VAFMTST=+$O(^DG(408.32,"C",VAFMTS,0)),VAFMTST=$G(^DG(408.32,+VAFMTST,0)),VAFMTST=$P(VAFMTST,"^",2)
.S $P(VAFY,VAFHLFS,5)=$S($G(VAFMTST)]"":VAFMTST,1:VAFHLQ) ; Means Test Status
;
I VAFSTR[",6," D
.I $P(VAFANOD,"^",9)]"" D
..S VAFELIG=+$O(^DIC(8,"B",$P(VAFANOD,"^",9),0)),VAFELIG=$P($G(^DIC(8,VAFELIG,0)),"^",9)
.S $P(VAFY,VAFHLFS,6)=$S(+$G(VAFELIG)>0:VAFELIG,1:VAFHLQ) ; Primary Eligibility Code
;
I VAFSTR[",7," S $P(VAFY,VAFHLFS,7)=$S($P(VAFCLM,"^",1)]"":$$HLDATE^HLFNC($P(VAFCLM,"^",1)),1:VAFHLQ) ; Claim Date
;
ENQ Q "ZBT"_VAFHLFS_$G(VAFY)
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HVAFHLZBT 3256 printed Oct 16, 2024@19:03:49 Page 2
VAFHLZBT ;ALB/KCL,CKN - CREATE HL7 BENEFICIARY TRAVEL (ZBT) SEGMENT ; 12/6/06 3:25pm
+1 ;;5.3;Registration;**122,688**;Aug 13, 1993;Build 29
+2 ;
+3 ;
+4 ; This generic extrinsic function is designed to return the HL7
+5 ; Beneficiary Travel (ZBT) segment. This segment contains VA-
+6 ; specific Beneficiary Travel data for a selected patient.
+7 ;
+8 ;
EN(VAFDATE,VAFSTR,VAFHLQ,VAFHLFS) ; --
+1 ; Entry point for creating HL7 ZBT segment
+2 ;
+3 ; Input(s):
+4 ; VAFDATE - internal entry number of Bene Travel Claim (#392) file
+5 ; VAFSTR - (optional) string of fields requested, separated by
+6 ; commas. If not passed, return all data fields.
+7 ; VAFHLQ - (optional) HL7 null variable.
+8 ; VAFHLFS - (optional) HL7 field separator.
+9 ;
+10 ; Output:
+11 ; String containing the desired components of the HL7 ZBT segment
+12 ;
+13 ;
+14 NEW VAFANOD,VAFCERT,VAFCLM,VAFMTS,VAFY,X,Y
+15 ;
+16 ; if VAFHLQ or VAFHLFS not passed, use default HL7 variables
+17 SET VAFHLQ=$SELECT($DATA(VAFHLQ):VAFHLQ,1:$GET(HLQ))
SET VAFHLFS=$SELECT($DATA(VAFHLFS):VAFHLFS,1:$GET(HLFS))
+18 ;
+19 ;If VAFDATE not passed, populate all valid seq. with ""(dbl quotes)
+20 IF '$GET(VAFDATE)
Begin DoDot:1
+21 SET VAFY=1
+22 IF $GET(VAFSTR)
FOR I=2:1:$LENGTH(VAFSTR,",")
SET $PIECE(VAFY,VAFHLFS,$PIECE(VAFSTR,",",I))=VAFHLQ
+23 IF '$TEST
FOR I=2:1:7
SET $PIECE(VAFY,VAFHLFS,I)=VAFHLQ
End DoDot:1
GOTO ENQ
+24 ;
+25 ; zero node from BENE TRAVEL CLAIM (#392) file
+26 SET VAFCLM=$GET(^DGBT(392,VAFDATE,0))
+27 ; convert 5th piece to pointer value
+28 SET Y=0
SET X=$PIECE(VAFCLM,"^",5)
IF X'=""
DO ^%DT
SET X=9999999-Y
+29 ;
+30 ; zero & 'A' node from BENE TRAVEL CERT. (#392.2) file
+31 SET VAFCERT=$GET(^DGBT(392.2,+$ORDER(^DGBT(392.2,"C",+$PIECE(VAFCLM,"^",2),+X)),0))
SET VAFANOD=$GET(^("A"))
+32 IF VAFCERT=""
SET VAFCERT=$GET(^DGBT(392.2,+$ORDER(^DGBT(392.2,"C",+$PIECE(VAFCLM,"^",2),0)),0))
SET VAFANOD=$GET(^("A"))
+33 ;
+34 ;If no certificate, populate all valid seq. with ""(dbl quotes)
+35 IF VAFCERT=""
Begin DoDot:1
+36 SET VAFY=1
+37 IF $GET(VAFSTR)
FOR I=2:1:$LENGTH(VAFSTR,",")
SET $PIECE(VAFY,VAFHLFS,$PIECE(VAFSTR,",",I))=VAFHLQ
+38 IF '$TEST
FOR I=2:1:7
SET $PIECE(VAFY,VAFHLFS,I)=VAFHLQ
End DoDot:1
GOTO ENQ
+39 ;
+40 ; if VAFSTR not passed, return all data fields
+41 IF $GET(VAFSTR)']""
SET VAFSTR="2,3,4,5,6,7"
+42 SET $PIECE(VAFY,VAFHLFS,8)=""
SET VAFSTR=","_VAFSTR_","
+43 ;
+44 ; Set Id - always 1
SET $PIECE(VAFY,VAFHLFS,1)=1
+45 ; Date Certified
IF VAFSTR[",2,"
SET $PIECE(VAFY,VAFHLFS,2)=$SELECT($PIECE(VAFCERT,"^",1)]"":$$HLDATE^HLFNC($PIECE(VAFCERT,"^",1)),1:VAFHLQ)
+46 ; Eligible
IF VAFSTR[",3,"
SET X=$$YN^VAFHLFNC($PIECE(VAFCERT,"^",3))
SET $PIECE(VAFY,VAFHLFS,3)=$SELECT(X]"":X,1:VAFHLQ)
+47 ; Amount Certified (amount of income reported)
IF VAFSTR[",4,"
SET $PIECE(VAFY,VAFHLFS,4)=$SELECT($PIECE(VAFCERT,"^",4)]"":$PIECE(VAFCERT,"^",4),1:VAFHLQ)
+48 ;
+49 IF VAFSTR[",5,"
Begin DoDot:1
+50 IF $PIECE(VAFANOD,"^",8)]""
Begin DoDot:2
+51 SET VAFMTS=$PIECE(VAFANOD,"^",8)
+52 IF $LENGTH(VAFMTS)>1
SET VAFMTS=$TRANSLATE(VAFMTS," ","")
+53 IF $LENGTH(VAFMTS)<1
SET VAFMTST=""
QUIT
+54 SET VAFMTST=+$ORDER(^DG(408.32,"C",VAFMTS,0))
SET VAFMTST=$GET(^DG(408.32,+VAFMTST,0))
SET VAFMTST=$PIECE(VAFMTST,"^",2)
End DoDot:2
+55 ; Means Test Status
SET $PIECE(VAFY,VAFHLFS,5)=$SELECT($GET(VAFMTST)]"":VAFMTST,1:VAFHLQ)
End DoDot:1
+56 ;
+57 IF VAFSTR[",6,"
Begin DoDot:1
+58 IF $PIECE(VAFANOD,"^",9)]""
Begin DoDot:2
+59 SET VAFELIG=+$ORDER(^DIC(8,"B",$PIECE(VAFANOD,"^",9),0))
SET VAFELIG=$PIECE($GET(^DIC(8,VAFELIG,0)),"^",9)
End DoDot:2
+60 ; Primary Eligibility Code
SET $PIECE(VAFY,VAFHLFS,6)=$SELECT(+$GET(VAFELIG)>0:VAFELIG,1:VAFHLQ)
End DoDot:1
+61 ;
+62 ; Claim Date
IF VAFSTR[",7,"
SET $PIECE(VAFY,VAFHLFS,7)=$SELECT($PIECE(VAFCLM,"^",1)]"":$$HLDATE^HLFNC($PIECE(VAFCLM,"^",1)),1:VAFHLQ)
+63 ;
ENQ QUIT "ZBT"_VAFHLFS_$GET(VAFY)
