DGBTR17 ;ALB/RFE - VOUCHER REPORT; 03/14/12
;;1.0;Beneficiary Travel;**20**;November 11, 2011;Build 185
Q
EN ; Entry point
N %,%Y,ACCOUNT,ADDRLIN,ALLOW,CCFEE,DED,DEPARTLIN,DESTLIN,DFN,DGBTDIV,DGBTDIVI,DGBTDIVN,DGBTEXCEL,DGBTQ,ECON,ENDDT,ENTRY,ERR,EQUAL,FERRIES,FACLIN
N FIRSTPAGE,GRAND,I,II,LINEZERO,MASDATE,MASLIN,MASRATE,MEALS,MILES,MILESRATE,MILESTRAV,RAY,PAGE,PATSTATE,PATZERO,POP,PDT,SQ1,SQ2,STARTDT,TMPADD,TRIPS
N TRIPTYP,WRTLIN,X,X2,X3,Y,ZTQUEUED
K ^TMP("DGBTVRPT",$J)
D CLEAN^DILF
S X2="2$"
DIVISN ; if MED CTR DIV file set up (first record) and record does not exist, write warning and exit
S X=$G(^DG(40.8,0)) I X="" W !,"WARNING...MEDICAL CENTER DIVISION FILE IS NOT SET UP",!,"USE THE ADT PARAMETER OPTION FILE TO SET UP DIVISION" Q
; check if multi-divisional center (GL node exists and 2nd piece=1). Do lookup, if it exists-set local variables
I $D(^DG(43,1,"GL")),$P(^("GL"),U,2) D Q:Y'>0 Q:$D(ERR) D MAIN,QUIT Q
.S DGBTDIVN=$$YESNO^DGBTUTL("Do you wish to run this report for all divisions")
.I DGBTDIVN S DGBTDIVN="ALL",(DGBTDIVI,DGBTDIV)=0 Q
.I (($D(DIRUT))!($D(DTOUT))!($D(DUOUT))) Q
.K DIR S DIR(0)="P^40.8:EMZ" D ^DIR K DIR
.I (($D(DIRUT))!($D(DTOUT))!($D(DUOUT))) Q
.S DGBTDIVN=+Y,DGBTDIVI=$P(Y,U,2)
.D INSTIT
I (($D(DIRUT))!($D(DTOUT))!($D(DUOUT))) D CLEAN^DILF Q
; if not a multi-divisional center, default to institution name
S DGBTDIVN=$O(^DG(40.8,0)),DGBTDIVI=$P(^DG(40.8,DGBTDIVN,0),U) D INSTIT
Q:$D(ERR)
D MAIN
D QUIT
Q
MAIN ;
K DIR
S DIR("A")="START DATE: ",DIR(0)="DA^2991231:NOW:EX" D ^DIR K DIR
I ($D(DIRUT))!($D(DIROUT)) Q
S STARTDT=Y
S DIR("A")="END DATE: ",DIR(0)="DA^"_STARTDT_":NOW:EX" D ^DIR K DIR
I ($D(DIRUT))!($D(DIROUT)) Q
S ENDDT=Y
S DGBTEXCEL=$$SELEXCEL^DGBTUTL
I DGBTEXCEL="^" Q
I 'DGBTEXCEL N COLWID S COLWID=132 D PRINTMSG^DGBTUTL
D DEVICE^DGBTUTL("Beneficiary Travel Fiscal Report","MAIN1^DGBTR17(DGBTEXCEL,STARTDT,ENDDT,DGBTDIVI,DGBTDIVN,DGBTDIV)",DGBTEXCEL,132)
I $G(DGBTQ) Q
;
;I $D(IO("Q")) D:'$D(ZTQUEUED) ^%ZISC Q
D MAIN1(DGBTEXCEL,STARTDT,ENDDT,DGBTDIVI,DGBTDIVN,DGBTDIV)
D:'$D(ZTQUEUED) ^%ZISC
U IO
Q
MAIN1(DGBTEXCEL,STARTDT,ENDDT,DGBTDIVI,DGBTDIVN,DGBTDIV) ;
K ^TMP("DGBTVRPT",$J)
D GETRECS
I ($D(DIRUT))!($D(DIROUT))!($D(ERR)) Q
I '$D(^TMP("DGBTVRPT",$J)) W !,"NO VOUCHERS FOUND" Q
D PRINT
Q
PRINT ;
U IO
I DGBTEXCEL D
.W "NAME^ADD1^ADD2^CITY^STATE^ZIP^ID^FAC^DEP^DEST^MILES^M & L^TOTAL - 11^TOTAL - 13^CL DT^CERT^VOUCH DT^ACCOUNT^DED^CC FEE^PAYABLE"
.Q
N PROMPT
S PROMPT="",PAGE=0,$P(EQUAL,"=",133)=""
D NOW^%DTC S Y=% D DD^%DT S PDT=Y
S FIRSTPAGE=0
I 'DGBTEXCEL D HDR
S SQ1=""
F Q:PROMPT="^" S SQ1=$O(^TMP("DGBTVRPT",$J,SQ1)) Q:SQ1="" S SQ2="" D
.F S SQ2=$O(^TMP("DGBTVRPT",$J,SQ1,SQ2)) Q:SQ2="" D PRT Q:PROMPT="^"
K ^TMP("DGBTVRPT",$J)
I ('DGBTEXCEL),(PROMPT="^") Q
I 'DGBTEXCEL D GTOT
I IOST["C-" S Y=$$PAUSE^DGBTUTL(DGBTEXCEL)
I IOST'["C-" W !,"REPORT HAS FINISHED"
Q
GETRECS ;
F I="CLAIMS","MILES","ALLOW","M&L","F&B","ALLOW TOT","ECON","ECON TOT","PAYABLE","1W","RT","DED","CC FEE" S GRAND(I)=0
I DGBTDIVN'="ALL" D
.S RAY("FACILITY NAME")=$$GET1^DIQ(4,DGBTDIV,.01)
.S FACLIN=$G(^DIC(4,DGBTDIV,1))
.S RAY("FACILITY ADDR 1")=$P(FACLIN,"^")
.S RAY("FACILITY ADDR 2")=$P(FACLIN,"^",2)
.S RAY("FACILITY CITY")=$P(FACLIN,"^",3)
S PATSTATE=$$GET1^DIQ(4,DGBTDIV,.02,"I")
S RAY("FACILITY STATE")=$$GET1^DIQ(5,PATSTATE,1)
S RAY("FACILITY ZIP")=$$GET1^DIQ(4,DGBTDIV,1.04)
S ENTRY=$O(^DGBT(392,"D",STARTDT),-1)
F S ENTRY=$O(^DGBT(392,"D",ENTRY)) Q:ENTRY="" Q:ENTRY>ENDDT D
.S I=""
.F S I=$O(^DGBT(392,"D",ENTRY,I)) Q:I="" I $$FAC(I),($$GET1^DIQ(392,I,56,"I")="M"),'($$GET1^DIQ(392,I,45.2,"I")) D REC
Q
QUIT ;
K ^TMP("DGBTVRPT",$J)
D CLEAN^DILF
Q
REC ;
I DGBTDIVN="ALL" D
.S DGBTDIVI=$$GET1^DIQ(40.8,$$GET1^DIQ(392,I,11,"I"),.01),DGBTDIV=$$GET1^DIQ(40.8,$$GET1^DIQ(392,I,11,"I"),.07,"I")
.S RAY("FACILITY NAME")=$$GET1^DIQ(4,DGBTDIV,.01)
.S FACLIN=$G(^DIC(4,DGBTDIV,1))
.S RAY("FACILITY ADDR 1")=$P(FACLIN,"^")
.S RAY("FACILITY ADDR 2")=$P(FACLIN,"^",2)
.S RAY("FACILITY CITY")=$P(FACLIN,"^",3)
S LINEZERO=^DGBT(392,I,0)
S DFN=$P(LINEZERO,"^",2)
S PATZERO=$G(^DPT(DFN,0))
S SQ1=RAY("FACILITY NAME")_"^"_$P(I,".")_"^"_$P(PATZERO,",")
S SQ2=$O(^TMP("DGBTVRPT",$J,SQ1,""),-1)+1
S GRAND("CLAIMS")=GRAND("CLAIMS")+1
S CCFEE=$$GET1^DIQ(392,I,55)
S RAY("NAME")=$P(PATZERO,"^")
S WRTLIN=$P(PATZERO,"^")
S TMPADD=$$GET1^DIQ(2,DFN,.12105)
S ADDRLIN=$G(^DPT(DFN,$S(TMPADD="YES":.121,1:.11)))
S MASLIN=$$MASLIN
F II=1:1:4 S WRTLIN=WRTLIN_"^"_$P(ADDRLIN,"^",II)
F II=1:1:3 S RAY("PAT ADDR "_II)=$P(ADDRLIN,"^",II)
S RAY("PAT CITY")=$P(ADDRLIN,"^",4)
S PATSTATE=$$GET1^DIQ(2,DFN,$S(TMPADD="YES":.1215,1:.115),"I")
S RAY("PAT STATE")=$$GET1^DIQ(5,PATSTATE,1)
S RAY("PAT ZIP")=$$GET1^DIQ(2,DFN,$S(TMPADD="YES":.1216,1:.116))
S RAY("SOCIAL SECURITY")=$P(PATZERO,"^",9)
S RAY("FISCAL SYMBOL")=$P(MASLIN,"^",4)
S DEPARTLIN=$G(^DGBT(392,I,"D"))
F II=1:1:3 S RAY("DEPARTURE "_II)=$P(DEPARTLIN,"^",II)
S RAY("DEPARTURE CITY")=$P(DEPARTLIN,"^",4)
S PATSTATE=$$GET1^DIQ(392,I,24.1,"I")
S RAY("DEPARTURE STATE")=$$GET1^DIQ(5,PATSTATE,1)
S RAY("DEPARTURE ZIP")=$$GET1^DIQ(392,I,24.2)
S DESTLIN=$G(^DGBT(392,I,"T"))
F II=1:1:3 S RAY("DESTINATION "_II)=$P(DESTLIN,"^",II)
S RAY("DESTINATION CITY")=$P(DESTLIN,"^",4)
S PATSTATE=$$GET1^DIQ(392,I,28.1,"I")
S RAY("DESTINATION STATE")=$$GET1^DIQ(5,PATSTATE,1)
S RAY("DESTINATION ZIP")=$$GET1^DIQ(392,I,28.2)
S MILES=$G(^DGBT(392,I,"M"))
S (MILESTRAV,RAY("MILES TRAVELED"))=$P(MILES,"^")*$P(MILES,"^",2)
S GRAND("MILES")=GRAND("MILES")+MILESTRAV
S (MILESRATE,RAY("MILES RATE"))=$P(MASLIN,"^",3)
S ALLOW=(MILESTRAV*MILESRATE)
S RAY("MILEAGE ALLOWANCE")=$$DLRAMT(ALLOW)
S GRAND("ALLOW")=GRAND("ALLOW")+ALLOW
S MEALS=$P(MILES,"^",4)
S RAY("MEALS LODGING")=$$DLRAMT(MEALS)
S GRAND("M&L")=GRAND("M&L")+MEALS
S FERRIES=$P(MILES,"^",5)
S RAY("FERRIES")=$$DLRAMT(FERRIES)
S GRAND("F&B")=GRAND("F&B")+FERRIES
S RAY("MILEAGE TOTAL")=$$DLRAMT(ALLOW+MEALS+FERRIES)
S GRAND("ALLOW TOT")=GRAND("ALLOW TOT")+ALLOW+MEALS+FERRIES
S ECON=$P(LINEZERO,"^",8)
S RAY("ECONOMICAL")=$$DLRAMT(ECON)
S GRAND("ECON")=GRAND("ECON")+ECON
S RAY("TRANS TOTAL")=$$DLRAMT(MEALS+ECON)
S GRAND("ECON TOT")=GRAND("ECON TOT")+MEALS+ECON
S RAY("PAYABLE")=$$DLRAMT($P(LINEZERO,U,10))
S GRAND("PAYABLE")=GRAND("PAYABLE")+$P(LINEZERO,U,10) S RAY("CLAIM DATE")=$$FMTE^XLFDT(I)
I DGBTEXCEL S RAY("CLAIM DATE")=$P(RAY("CLAIM DATE"),"@")
S RAY("PAYEE SIGNATURE")="" ; Future use
S RAY("VOUCHER DATE")=$$GET1^DIQ(392,I,13)
S RAY("CERT OFFICIAL")=$$GET1^DIQ(392,I,12)
S RAY("REMARKS")=$TR($G(^DGBT(392,I,"R")),"^","")
S ACCOUNT=$$GET1^DIQ(392,I,6,"I")
S RAY("ACCOUNT")=$$GET1^DIQ(392.3,ACCOUNT,2)
S RAY("COMMON CARRIER FEE")=$$DLRAMT(CCFEE)
S GRAND("CC FEE")=GRAND("CC FEE")+CCFEE
S RAY("ACC DED")=$$DLRAMT($P(LINEZERO,U,9))
D TOTMONTH Q:$D(ERR)
S RAY("ONE WAY")=TRIPS(1)
S RAY("ROUND TRIP")=TRIPS(2)
S RAY("DEDUCTIBLE")=$$DLRAMT(DED)
S GRAND("1W")=GRAND("1W")+TRIPS(1)
S GRAND("RT")=GRAND("RT")+TRIPS(2)
S GRAND("DED")=GRAND("DED")+DED
S WRTLIN=RAY("NAME")_"^"_RAY("PAT ADDR 1")_"^"_RAY("PAT ADDR 2")_"^"_RAY("PAT ADDR 3")_"^"_RAY("PAT CITY")_"^"_RAY("PAT STATE")_"^"_RAY("PAT ZIP")
S WRTLIN=WRTLIN_"^"_RAY("SOCIAL SECURITY")_"^"_RAY("FACILITY NAME")_"^"_RAY("FACILITY ADDR 1")_"^"_RAY("FACILITY ADDR 2")_"^"_RAY("FACILITY CITY")
S WRTLIN=WRTLIN_"^"_RAY("FACILITY STATE")_"^"_RAY("FACILITY ZIP")_"^"_RAY("FISCAL SYMBOL")_"^"_RAY("DEPARTURE 1")_"^"_RAY("DEPARTURE 2")
S WRTLIN=WRTLIN_"^"_RAY("DEPARTURE 3")_"^"_RAY("DEPARTURE CITY")_"^"_RAY("DEPARTURE STATE")_"^"_RAY("DEPARTURE ZIP")_"^"_RAY("DESTINATION 1")
S WRTLIN=WRTLIN_"^"_RAY("DESTINATION 2")_"^"_RAY("DESTINATION 3")_"^"_RAY("DESTINATION CITY")_"^"_RAY("DESTINATION STATE")_"^"_RAY("DESTINATION ZIP")
S WRTLIN=WRTLIN_"^"_RAY("MILES TRAVELED")_"^"_RAY("MILES RATE")_"^"_RAY("MILEAGE ALLOWANCE")_"^"_RAY("MEALS LODGING")_"^"_RAY("FERRIES")
S WRTLIN=WRTLIN_"^"_RAY("MILEAGE TOTAL")_"^"_RAY("ECONOMICAL")_"^"_RAY("TRANS TOTAL")_"^"_RAY("PAYABLE")_"^"_RAY("CLAIM DATE")_"^"_RAY("CERT OFFICIAL")
S WRTLIN=WRTLIN_"^^"_RAY("VOUCHER DATE")_"^"_RAY("REMARKS")_"^"_RAY("ACCOUNT")_"^"_RAY("COMMON CARRIER FEE")_"^"_RAY("ONE WAY")_"^"_RAY("ROUND TRIP")
S WRTLIN=WRTLIN_"^"_RAY("DEDUCTIBLE")_U_RAY("ACC DED")
S ^TMP("DGBTVRPT",$J,SQ1,SQ2)=WRTLIN
Q
FAC(J) ;
I DGBTDIVN="ALL" Q 1
Q $$GET1^DIQ(392,J,11,"I")=DGBTDIVN
MASLIN() ;
S MASRATE=""
I $D(^DG(43.1,"B",$P(I,"."))) S MASRATE=$O(^DG(43.1,$P(I,".","")))
E S MASDATE=$O(^DG(43.1,"B",$P(I,".")),-1) I MASDATE'="" S MASRATE=$O(^DG(43.1,"B",MASDATE,""))
I MASRATE="" Q ""
Q $G(^DG(43.1,MASRATE,"BT"))
TOTMONTH ;
N DTRAY
F II=0,1,2 S TRIPS(II)=0
S DED=0
S II=$O(^DGBT(392,"C",DFN,$E(I,1,5)_"00"),-1)
F S II=$O(^DGBT(392,"C",DFN,II)) Q:II="" Q:$P(II,".")'<$P(I,".") D
.I '$$FAC(II) Q
.Q:$D(^DGBT(392,II,"C"))
.I $D(DTRAY($P(II,"."))) Q
.I $$GET1^DIQ(392,II,45.2,"I") Q ;'=0 Q
.I $$GET1^DIQ(392.3,$$GET1^DIQ(392,II,6,"I"),2)'=829 Q
.S DTRAY($P(II,"."))=""
.S DED=DED+$$GET1^DIQ(392,II,9)
.S TRIPTYP=+$$GET1^DIQ(392,II,31,"I")
.S TRIPS(TRIPTYP)=TRIPS(TRIPTYP)+1
Q
INSTIT ; check for pointer to institution file and for address information on institution
S DGBTDIV=$$GET1^DIQ(40.8,DGBTDIVN,.07,"I")
Q
;
PRT ;
S WRTLIN=^TMP("DGBTVRPT",$J,SQ1,SQ2)
I DGBTEXCEL D Q
.W !,$P(WRTLIN,U),U,$P(WRTLIN,U,2),U,$P(WRTLIN,U,3),U,$P(WRTLIN,U,5),U,$P(WRTLIN,U,6),U,$P(WRTLIN,U,7),U,$P(WRTLIN,U,8),U,$P(WRTLIN,U,9),U
.W $P(WRTLIN,U,21),U,$P(WRTLIN,U,27),U,$P(WRTLIN,U,28),U,$P(WRTLIN,U,31),U,$P(WRTLIN,U,33),U,$P(WRTLIN,U,35),U,$P(WRTLIN,U,37),U
.W $P(WRTLIN,U,38),U,$P(WRTLIN,U,40),U,$P(WRTLIN,U,42),U,$P(WRTLIN,U,47),U,$P(WRTLIN,U,43),U,$P(WRTLIN,U,36)
I (($Y+11)>IOSL)&(FIRSTPAGE)&('DGBTEXCEL) D Q:PROMPT[U
.I ($E(IOST,1)="C"),(IOSL'[99) D Q:PROMPT[U
..K DIR
..S DIR("A")="PRESS RETURN TO CONTINUE OR '^' TO STOP....",DIR(0)="FAO" D ^DIR S PROMPT=Y K DIR
.D HDR
S FIRSTPAGE=1
W !,$P(WRTLIN,U),?32,$P(WRTLIN,U,8),?45,$P(WRTLIN,U,37),?67,$P(WRTLIN,U,40),?81,$P(WRTLIN,U,38),?118,$P(WRTLIN,U,42)
W !,?5,$P(WRTLIN,U,2)," ",$P(WRTLIN,U,3)," ",$P(WRTLIN,U,4)
W !,?5,$P(WRTLIN,U,5),?22,$P(WRTLIN,U,6),?26,$P(WRTLIN,U,7),?38,$P(WRTLIN,U,9)," ",$P(WRTLIN,U,10)
I $P(WRTLIN,U,11)'="" W !,?5,$P(WRTLIN,U,11)," ",$P(WRTLIN,U,12)," ",$P(WRTLIN,U,13)," ",$P(WRTLIN,U,14)," ",$P(WRTLIN,U,15)
I $P(WRTLIN,U,11)="" W !,?5,$P(WRTLIN,U,12)," ",$P(WRTLIN,U,13)," ",$P(WRTLIN,U,14)," ",$P(WRTLIN,U,15)
W !,?5,$P(WRTLIN,U,16)," ",$P(WRTLIN,U,17)," ",$P(WRTLIN,U,18)
W !,?5,$P(WRTLIN,U,19)," ",$P(WRTLIN,U,20)," ",$P(WRTLIN,U,21)
W !,?5,$P(WRTLIN,U,22)," ",$P(WRTLIN,U,23)," ",$P(WRTLIN,U,24)
W !,?5,$P(WRTLIN,U,25)," ",$P(WRTLIN,U,26)," ",$P(WRTLIN,U,27)
W !,?5,$P(WRTLIN,U,28),?11,$P(WRTLIN,U,29),?18,$P(WRTLIN,U,30),?30,$P(WRTLIN,U,31),?42,$P(WRTLIN,U,32),?54,$P(WRTLIN,U,33),?67,$P(WRTLIN,U,34)
W ?79,$P(WRTLIN,U,35),?90,$P(WRTLIN,U,36),?102,$P(WRTLIN,U,44),?106,$P(WRTLIN,U,45),?110,$P(WRTLIN,U,46),?121,$P(WRTLIN,U,43)
W !,?5,$P(WRTLIN,U,41),?87,$P(WRTLIN,U,15)
Q
HDR ;
S PAGE=PAGE+1
W @IOF
W "BT ELECTRONIC VOUCHER REPORT PRINT DATE: ",PDT,?(126-$L(PAGE)),"PAGE ",PAGE
W !,$$FMTE^XLFDT(STARTDT)," TO ",$$FMTE^XLFDT(ENDDT)
W !,"DIVISION: ",$S(DGBTDIVN="ALL":"ALL",1:DGBTDIVI)
W !,$E(EQUAL,1,127)
W !,"NAME",?32,"SSN",?45,"CLAIM DATE",?67,"ENTRY DATE",?81,"CLERK",?118,"ACCT"
W !,?5,"ADDRESS"
W !?5,"CITY",?22,"ST",?26,"ZIP",?38,"FACILITY"
W !,?5,"FACILITY ADDRESS"
W !,?5,"DEPARTURE"
W !,?5,"DEPARTURE"
W !,?5,"DESTINATION"
W !,?5,"DESTINATION"
W !,?5,"MILES",?11,"RATE",?18,"ALLOW",?30,"M&L",?42,"F&B",?54,"TOTAL",?67,"ECON",?79,"TOTAL",?90,"PAYABLE",?102,"1W",?106,"RT",?110,"DED",?121,"CC FEE"
W !,?5,"REMARKS",?87,"FISCAL SYMBOLS"
W !,$E(EQUAL,1,127)
Q
GTOT ;
W !,$E(EQUAL,1,127)
W !,"GRAND TOTALS"
W !,"MILES",?7,"CLMS",?14,"ALLOW",?26,"M&L",?38,"F&B",?50,"TOTAL",?63,"ECON",?75,"TOTAL",?86,"PAYABLE",?98,"1W",?102,"RT",?106,"DED",?117,"CC FEE"
W !,GRAND("MILES"),?7,GRAND("CLAIMS"),?14,$$DLRAMT(GRAND("ALLOW")),?26,$$DLRAMT(GRAND("M&L")),?38,$$DLRAMT(GRAND("F&B")),?50,$$DLRAMT(GRAND("ALLOW TOT"))
W ?63,$$DLRAMT(GRAND("ECON")),?75,$$DLRAMT(GRAND("ECON TOT")),?86,$$DLRAMT(GRAND("PAYABLE")),?98,GRAND("1W"),?102,GRAND("RT")
W ?106,$$DLRAMT(GRAND("DED")),?117,$$DLRAMT(GRAND("CC FEE"))
W !,$E(EQUAL,1,127)
Q
DLRAMT(X) ;
D COMMA^%DTC I 'DGBTEXCEL Q $TR(X," ","")
Q $TR(X," ,$","")
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDGBTR17 12616 printed Sep 23, 2025@19:17:01 Page 2
DGBTR17 ;ALB/RFE - VOUCHER REPORT; 03/14/12
+1 ;;1.0;Beneficiary Travel;**20**;November 11, 2011;Build 185
+2 QUIT
EN ; Entry point
+1 NEW %,%Y,ACCOUNT,ADDRLIN,ALLOW,CCFEE,DED,DEPARTLIN,DESTLIN,DFN,DGBTDIV,DGBTDIVI,DGBTDIVN,DGBTEXCEL,DGBTQ,ECON,ENDDT,ENTRY,ERR,EQUAL,FERRIES,FACLIN
+2 NEW FIRSTPAGE,GRAND,I,II,LINEZERO,MASDATE,MASLIN,MASRATE,MEALS,MILES,MILESRATE,MILESTRAV,RAY,PAGE,PATSTATE,PATZERO,POP,PDT,SQ1,SQ2,STARTDT,TMPADD,TRIPS
+3 NEW TRIPTYP,WRTLIN,X,X2,X3,Y,ZTQUEUED
+4 KILL ^TMP("DGBTVRPT",$JOB)
+5 DO CLEAN^DILF
+6 SET X2="2$"
DIVISN ; if MED CTR DIV file set up (first record) and record does not exist, write warning and exit
+1 SET X=$GET(^DG(40.8,0))
IF X=""
WRITE !,"WARNING...MEDICAL CENTER DIVISION FILE IS NOT SET UP",!,"USE THE ADT PARAMETER OPTION FILE TO SET UP DIVISION"
QUIT
+2 ; check if multi-divisional center (GL node exists and 2nd piece=1). Do lookup, if it exists-set local variables
+3 IF $DATA(^DG(43,1,"GL"))
IF $PIECE(^("GL"),U,2)
Begin DoDot:1
+4 SET DGBTDIVN=$$YESNO^DGBTUTL("Do you wish to run this report for all divisions")
+5 IF DGBTDIVN
SET DGBTDIVN="ALL"
SET (DGBTDIVI,DGBTDIV)=0
QUIT
+6 IF (($DATA(DIRUT))!($DATA(DTOUT))!($DATA(DUOUT)))
QUIT
+7 KILL DIR
SET DIR(0)="P^40.8:EMZ"
DO ^DIR
KILL DIR
+8 IF (($DATA(DIRUT))!($DATA(DTOUT))!($DATA(DUOUT)))
QUIT
+9 SET DGBTDIVN=+Y
SET DGBTDIVI=$PIECE(Y,U,2)
+10 DO INSTIT
End DoDot:1
if Y'>0
QUIT
if $DATA(ERR)
QUIT
DO MAIN
DO QUIT
QUIT
+11 IF (($DATA(DIRUT))!($DATA(DTOUT))!($DATA(DUOUT)))
DO CLEAN^DILF
QUIT
+12 ; if not a multi-divisional center, default to institution name
+13 SET DGBTDIVN=$ORDER(^DG(40.8,0))
SET DGBTDIVI=$PIECE(^DG(40.8,DGBTDIVN,0),U)
DO INSTIT
+14 if $DATA(ERR)
QUIT
+15 DO MAIN
+16 DO QUIT
+17 QUIT
MAIN ;
+1 KILL DIR
+2 SET DIR("A")="START DATE: "
SET DIR(0)="DA^2991231:NOW:EX"
DO ^DIR
KILL DIR
+3 IF ($DATA(DIRUT))!($DATA(DIROUT))
QUIT
+4 SET STARTDT=Y
+5 SET DIR("A")="END DATE: "
SET DIR(0)="DA^"_STARTDT_":NOW:EX"
DO ^DIR
KILL DIR
+6 IF ($DATA(DIRUT))!($DATA(DIROUT))
QUIT
+7 SET ENDDT=Y
+8 SET DGBTEXCEL=$$SELEXCEL^DGBTUTL
+9 IF DGBTEXCEL="^"
QUIT
+10 IF 'DGBTEXCEL
NEW COLWID
SET COLWID=132
DO PRINTMSG^DGBTUTL
+11 DO DEVICE^DGBTUTL("Beneficiary Travel Fiscal Report","MAIN1^DGBTR17(DGBTEXCEL,STARTDT,ENDDT,DGBTDIVI,DGBTDIVN,DGBTDIV)",DGBTEXCEL,132)
+12 IF $GET(DGBTQ)
QUIT
+13 ;
+14 ;I $D(IO("Q")) D:'$D(ZTQUEUED) ^%ZISC Q
+15 DO MAIN1(DGBTEXCEL,STARTDT,ENDDT,DGBTDIVI,DGBTDIVN,DGBTDIV)
+16 if '$DATA(ZTQUEUED)
DO ^%ZISC
+17 USE IO
+18 QUIT
MAIN1(DGBTEXCEL,STARTDT,ENDDT,DGBTDIVI,DGBTDIVN,DGBTDIV) ;
+1 KILL ^TMP("DGBTVRPT",$JOB)
+2 DO GETRECS
+3 IF ($DATA(DIRUT))!($DATA(DIROUT))!($DATA(ERR))
QUIT
+4 IF '$DATA(^TMP("DGBTVRPT",$JOB))
WRITE !,"NO VOUCHERS FOUND"
QUIT
+5 DO PRINT
+6 QUIT
PRINT ;
+1 USE IO
+2 IF DGBTEXCEL
Begin DoDot:1
+3 WRITE "NAME^ADD1^ADD2^CITY^STATE^ZIP^ID^FAC^DEP^DEST^MILES^M & L^TOTAL - 11^TOTAL - 13^CL DT^CERT^VOUCH DT^ACCOUNT^DED^CC FEE^PAYABLE"
+4 QUIT
End DoDot:1
+5 NEW PROMPT
+6 SET PROMPT=""
SET PAGE=0
SET $PIECE(EQUAL,"=",133)=""
+7 DO NOW^%DTC
SET Y=%
DO DD^%DT
SET PDT=Y
+8 SET FIRSTPAGE=0
+9 IF 'DGBTEXCEL
DO HDR
+10 SET SQ1=""
+11 FOR
if PROMPT="^"
QUIT
SET SQ1=$ORDER(^TMP("DGBTVRPT",$JOB,SQ1))
if SQ1=""
QUIT
SET SQ2=""
Begin DoDot:1
+12 FOR
SET SQ2=$ORDER(^TMP("DGBTVRPT",$JOB,SQ1,SQ2))
if SQ2=""
QUIT
DO PRT
if PROMPT="^"
QUIT
End DoDot:1
+13 KILL ^TMP("DGBTVRPT",$JOB)
+14 IF ('DGBTEXCEL)
IF (PROMPT="^")
QUIT
+15 IF 'DGBTEXCEL
DO GTOT
+16 IF IOST["C-"
SET Y=$$PAUSE^DGBTUTL(DGBTEXCEL)
+17 IF IOST'["C-"
WRITE !,"REPORT HAS FINISHED"
+18 QUIT
GETRECS ;
+1 FOR I="CLAIMS","MILES","ALLOW","M&L","F&B","ALLOW TOT","ECON","ECON TOT","PAYABLE","1W","RT","DED","CC FEE"
SET GRAND(I)=0
+2 IF DGBTDIVN'="ALL"
Begin DoDot:1
+3 SET RAY("FACILITY NAME")=$$GET1^DIQ(4,DGBTDIV,.01)
+4 SET FACLIN=$GET(^DIC(4,DGBTDIV,1))
+5 SET RAY("FACILITY ADDR 1")=$PIECE(FACLIN,"^")
+6 SET RAY("FACILITY ADDR 2")=$PIECE(FACLIN,"^",2)
+7 SET RAY("FACILITY CITY")=$PIECE(FACLIN,"^",3)
End DoDot:1
+8 SET PATSTATE=$$GET1^DIQ(4,DGBTDIV,.02,"I")
+9 SET RAY("FACILITY STATE")=$$GET1^DIQ(5,PATSTATE,1)
+10 SET RAY("FACILITY ZIP")=$$GET1^DIQ(4,DGBTDIV,1.04)
+11 SET ENTRY=$ORDER(^DGBT(392,"D",STARTDT),-1)
+12 FOR
SET ENTRY=$ORDER(^DGBT(392,"D",ENTRY))
if ENTRY=""
QUIT
if ENTRY>ENDDT
QUIT
Begin DoDot:1
+13 SET I=""
+14 FOR
SET I=$ORDER(^DGBT(392,"D",ENTRY,I))
if I=""
QUIT
IF $$FAC(I)
IF ($$GET1^DIQ(392,I,56,"I")="M")
IF '($$GET1^DIQ(392,I,45.2,"I"))
DO REC
End DoDot:1
+15 QUIT
QUIT ;
+1 KILL ^TMP("DGBTVRPT",$JOB)
+2 DO CLEAN^DILF
+3 QUIT
REC ;
+1 IF DGBTDIVN="ALL"
Begin DoDot:1
+2 SET DGBTDIVI=$$GET1^DIQ(40.8,$$GET1^DIQ(392,I,11,"I"),.01)
SET DGBTDIV=$$GET1^DIQ(40.8,$$GET1^DIQ(392,I,11,"I"),.07,"I")
+3 SET RAY("FACILITY NAME")=$$GET1^DIQ(4,DGBTDIV,.01)
+4 SET FACLIN=$GET(^DIC(4,DGBTDIV,1))
+5 SET RAY("FACILITY ADDR 1")=$PIECE(FACLIN,"^")
+6 SET RAY("FACILITY ADDR 2")=$PIECE(FACLIN,"^",2)
+7 SET RAY("FACILITY CITY")=$PIECE(FACLIN,"^",3)
End DoDot:1
+8 SET LINEZERO=^DGBT(392,I,0)
+9 SET DFN=$PIECE(LINEZERO,"^",2)
+10 SET PATZERO=$GET(^DPT(DFN,0))
+11 SET SQ1=RAY("FACILITY NAME")_"^"_$PIECE(I,".")_"^"_$PIECE(PATZERO,",")
+12 SET SQ2=$ORDER(^TMP("DGBTVRPT",$JOB,SQ1,""),-1)+1
+13 SET GRAND("CLAIMS")=GRAND("CLAIMS")+1
+14 SET CCFEE=$$GET1^DIQ(392,I,55)
+15 SET RAY("NAME")=$PIECE(PATZERO,"^")
+16 SET WRTLIN=$PIECE(PATZERO,"^")
+17 SET TMPADD=$$GET1^DIQ(2,DFN,.12105)
+18 SET ADDRLIN=$GET(^DPT(DFN,$SELECT(TMPADD="YES":.121,1:.11)))
+19 SET MASLIN=$$MASLIN
+20 FOR II=1:1:4
SET WRTLIN=WRTLIN_"^"_$PIECE(ADDRLIN,"^",II)
+21 FOR II=1:1:3
SET RAY("PAT ADDR "_II)=$PIECE(ADDRLIN,"^",II)
+22 SET RAY("PAT CITY")=$PIECE(ADDRLIN,"^",4)
+23 SET PATSTATE=$$GET1^DIQ(2,DFN,$SELECT(TMPADD="YES":.1215,1:.115),"I")
+24 SET RAY("PAT STATE")=$$GET1^DIQ(5,PATSTATE,1)
+25 SET RAY("PAT ZIP")=$$GET1^DIQ(2,DFN,$SELECT(TMPADD="YES":.1216,1:.116))
+26 SET RAY("SOCIAL SECURITY")=$PIECE(PATZERO,"^",9)
+27 SET RAY("FISCAL SYMBOL")=$PIECE(MASLIN,"^",4)
+28 SET DEPARTLIN=$GET(^DGBT(392,I,"D"))
+29 FOR II=1:1:3
SET RAY("DEPARTURE "_II)=$PIECE(DEPARTLIN,"^",II)
+30 SET RAY("DEPARTURE CITY")=$PIECE(DEPARTLIN,"^",4)
+31 SET PATSTATE=$$GET1^DIQ(392,I,24.1,"I")
+32 SET RAY("DEPARTURE STATE")=$$GET1^DIQ(5,PATSTATE,1)
+33 SET RAY("DEPARTURE ZIP")=$$GET1^DIQ(392,I,24.2)
+34 SET DESTLIN=$GET(^DGBT(392,I,"T"))
+35 FOR II=1:1:3
SET RAY("DESTINATION "_II)=$PIECE(DESTLIN,"^",II)
+36 SET RAY("DESTINATION CITY")=$PIECE(DESTLIN,"^",4)
+37 SET PATSTATE=$$GET1^DIQ(392,I,28.1,"I")
+38 SET RAY("DESTINATION STATE")=$$GET1^DIQ(5,PATSTATE,1)
+39 SET RAY("DESTINATION ZIP")=$$GET1^DIQ(392,I,28.2)
+40 SET MILES=$GET(^DGBT(392,I,"M"))
+41 SET (MILESTRAV,RAY("MILES TRAVELED"))=$PIECE(MILES,"^")*$PIECE(MILES,"^",2)
+42 SET GRAND("MILES")=GRAND("MILES")+MILESTRAV
+43 SET (MILESRATE,RAY("MILES RATE"))=$PIECE(MASLIN,"^",3)
+44 SET ALLOW=(MILESTRAV*MILESRATE)
+45 SET RAY("MILEAGE ALLOWANCE")=$$DLRAMT(ALLOW)
+46 SET GRAND("ALLOW")=GRAND("ALLOW")+ALLOW
+47 SET MEALS=$PIECE(MILES,"^",4)
+48 SET RAY("MEALS LODGING")=$$DLRAMT(MEALS)
+49 SET GRAND("M&L")=GRAND("M&L")+MEALS
+50 SET FERRIES=$PIECE(MILES,"^",5)
+51 SET RAY("FERRIES")=$$DLRAMT(FERRIES)
+52 SET GRAND("F&B")=GRAND("F&B")+FERRIES
+53 SET RAY("MILEAGE TOTAL")=$$DLRAMT(ALLOW+MEALS+FERRIES)
+54 SET GRAND("ALLOW TOT")=GRAND("ALLOW TOT")+ALLOW+MEALS+FERRIES
+55 SET ECON=$PIECE(LINEZERO,"^",8)
+56 SET RAY("ECONOMICAL")=$$DLRAMT(ECON)
+57 SET GRAND("ECON")=GRAND("ECON")+ECON
+58 SET RAY("TRANS TOTAL")=$$DLRAMT(MEALS+ECON)
+59 SET GRAND("ECON TOT")=GRAND("ECON TOT")+MEALS+ECON
+60 SET RAY("PAYABLE")=$$DLRAMT($PIECE(LINEZERO,U,10))
+61 SET GRAND("PAYABLE")=GRAND("PAYABLE")+$PIECE(LINEZERO,U,10)
SET RAY("CLAIM DATE")=$$FMTE^XLFDT(I)
+62 IF DGBTEXCEL
SET RAY("CLAIM DATE")=$PIECE(RAY("CLAIM DATE"),"@")
+63 ; Future use
SET RAY("PAYEE SIGNATURE")=""
+64 SET RAY("VOUCHER DATE")=$$GET1^DIQ(392,I,13)
+65 SET RAY("CERT OFFICIAL")=$$GET1^DIQ(392,I,12)
+66 SET RAY("REMARKS")=$TRANSLATE($GET(^DGBT(392,I,"R")),"^","")
+67 SET ACCOUNT=$$GET1^DIQ(392,I,6,"I")
+68 SET RAY("ACCOUNT")=$$GET1^DIQ(392.3,ACCOUNT,2)
+69 SET RAY("COMMON CARRIER FEE")=$$DLRAMT(CCFEE)
+70 SET GRAND("CC FEE")=GRAND("CC FEE")+CCFEE
+71 SET RAY("ACC DED")=$$DLRAMT($PIECE(LINEZERO,U,9))
+72 DO TOTMONTH
if $DATA(ERR)
QUIT
+73 SET RAY("ONE WAY")=TRIPS(1)
+74 SET RAY("ROUND TRIP")=TRIPS(2)
+75 SET RAY("DEDUCTIBLE")=$$DLRAMT(DED)
+76 SET GRAND("1W")=GRAND("1W")+TRIPS(1)
+77 SET GRAND("RT")=GRAND("RT")+TRIPS(2)
+78 SET GRAND("DED")=GRAND("DED")+DED
+79 SET WRTLIN=RAY("NAME")_"^"_RAY("PAT ADDR 1")_"^"_RAY("PAT ADDR 2")_"^"_RAY("PAT ADDR 3")_"^"_RAY("PAT CITY")_"^"_RAY("PAT STATE")_"^"_RAY("PAT ZIP")
+80 SET WRTLIN=WRTLIN_"^"_RAY("SOCIAL SECURITY")_"^"_RAY("FACILITY NAME")_"^"_RAY("FACILITY ADDR 1")_"^"_RAY("FACILITY ADDR 2")_"^"_RAY("FACILITY CITY")
+81 SET WRTLIN=WRTLIN_"^"_RAY("FACILITY STATE")_"^"_RAY("FACILITY ZIP")_"^"_RAY("FISCAL SYMBOL")_"^"_RAY("DEPARTURE 1")_"^"_RAY("DEPARTURE 2")
+82 SET WRTLIN=WRTLIN_"^"_RAY("DEPARTURE 3")_"^"_RAY("DEPARTURE CITY")_"^"_RAY("DEPARTURE STATE")_"^"_RAY("DEPARTURE ZIP")_"^"_RAY("DESTINATION 1")
+83 SET WRTLIN=WRTLIN_"^"_RAY("DESTINATION 2")_"^"_RAY("DESTINATION 3")_"^"_RAY("DESTINATION CITY")_"^"_RAY("DESTINATION STATE")_"^"_RAY("DESTINATION ZIP")
+84 SET WRTLIN=WRTLIN_"^"_RAY("MILES TRAVELED")_"^"_RAY("MILES RATE")_"^"_RAY("MILEAGE ALLOWANCE")_"^"_RAY("MEALS LODGING")_"^"_RAY("FERRIES")
+85 SET WRTLIN=WRTLIN_"^"_RAY("MILEAGE TOTAL")_"^"_RAY("ECONOMICAL")_"^"_RAY("TRANS TOTAL")_"^"_RAY("PAYABLE")_"^"_RAY("CLAIM DATE")_"^"_RAY("CERT OFFICIAL")
+86 SET WRTLIN=WRTLIN_"^^"_RAY("VOUCHER DATE")_"^"_RAY("REMARKS")_"^"_RAY("ACCOUNT")_"^"_RAY("COMMON CARRIER FEE")_"^"_RAY("ONE WAY")_"^"_RAY("ROUND TRIP")
+87 SET WRTLIN=WRTLIN_"^"_RAY("DEDUCTIBLE")_U_RAY("ACC DED")
+88 SET ^TMP("DGBTVRPT",$JOB,SQ1,SQ2)=WRTLIN
+89 QUIT
FAC(J) ;
+1 IF DGBTDIVN="ALL"
QUIT 1
+2 QUIT $$GET1^DIQ(392,J,11,"I")=DGBTDIVN
MASLIN() ;
+1 SET MASRATE=""
+2 IF $DATA(^DG(43.1,"B",$PIECE(I,".")))
SET MASRATE=$ORDER(^DG(43.1,$PIECE(I,".","")))
+3 IF '$TEST
SET MASDATE=$ORDER(^DG(43.1,"B",$PIECE(I,".")),-1)
IF MASDATE'=""
SET MASRATE=$ORDER(^DG(43.1,"B",MASDATE,""))
+4 IF MASRATE=""
QUIT ""
+5 QUIT $GET(^DG(43.1,MASRATE,"BT"))
TOTMONTH ;
+1 NEW DTRAY
+2 FOR II=0,1,2
SET TRIPS(II)=0
+3 SET DED=0
+4 SET II=$ORDER(^DGBT(392,"C",DFN,$EXTRACT(I,1,5)_"00"),-1)
+5 FOR
SET II=$ORDER(^DGBT(392,"C",DFN,II))
if II=""
QUIT
if $PIECE(II,".")'<$PIECE(I,".")
QUIT
Begin DoDot:1
+6 IF '$$FAC(II)
QUIT
+7 if $DATA(^DGBT(392,II,"C"))
QUIT
+8 IF $DATA(DTRAY($PIECE(II,".")))
QUIT
+9 ;'=0 Q
IF $$GET1^DIQ(392,II,45.2,"I")
QUIT
+10 IF $$GET1^DIQ(392.3,$$GET1^DIQ(392,II,6,"I"),2)'=829
QUIT
+11 SET DTRAY($PIECE(II,"."))=""
+12 SET DED=DED+$$GET1^DIQ(392,II,9)
+13 SET TRIPTYP=+$$GET1^DIQ(392,II,31,"I")
+14 SET TRIPS(TRIPTYP)=TRIPS(TRIPTYP)+1
End DoDot:1
+15 QUIT
INSTIT ; check for pointer to institution file and for address information on institution
+1 SET DGBTDIV=$$GET1^DIQ(40.8,DGBTDIVN,.07,"I")
+2 QUIT
+3 ;
PRT ;
+1 SET WRTLIN=^TMP("DGBTVRPT",$JOB,SQ1,SQ2)
+2 IF DGBTEXCEL
Begin DoDot:1
+3 WRITE !,$PIECE(WRTLIN,U),U,$PIECE(WRTLIN,U,2),U,$PIECE(WRTLIN,U,3),U,$PIECE(WRTLIN,U,5),U,$PIECE(WRTLIN,U,6),U,$PIECE(WRTLIN,U,7),U,$PIECE(WRTLIN,U,8),U,$PIECE(WRTLIN,U,9),U
+4 WRITE $PIECE(WRTLIN,U,21),U,$PIECE(WRTLIN,U,27),U,$PIECE(WRTLIN,U,28),U,$PIECE(WRTLIN,U,31),U,$PIECE(WRTLIN,U,33),U,$PIECE(WRTLIN,U,35),U,$PIECE(WRTLIN,U,37),U
+5 WRITE $PIECE(WRTLIN,U,38),U,$PIECE(WRTLIN,U,40),U,$PIECE(WRTLIN,U,42),U,$PIECE(WRTLIN,U,47),U,$PIECE(WRTLIN,U,43),U,$PIECE(WRTLIN,U,36)
End DoDot:1
QUIT
+6 IF (($Y+11)>IOSL)&(FIRSTPAGE)&('DGBTEXCEL)
Begin DoDot:1
+7 IF ($EXTRACT(IOST,1)="C")
IF (IOSL'[99)
Begin DoDot:2
+8 KILL DIR
+9 SET DIR("A")="PRESS RETURN TO CONTINUE OR '^' TO STOP...."
SET DIR(0)="FAO"
DO ^DIR
SET PROMPT=Y
KILL DIR
End DoDot:2
if PROMPT[U
QUIT
+10 DO HDR
End DoDot:1
if PROMPT[U
QUIT
+11 SET FIRSTPAGE=1
+12 WRITE !,$PIECE(WRTLIN,U),?32,$PIECE(WRTLIN,U,8),?45,$PIECE(WRTLIN,U,37),?67,$PIECE(WRTLIN,U,40),?81,$PIECE(WRTLIN,U,38),?118,$PIECE(WRTLIN,U,42)
+13 WRITE !,?5,$PIECE(WRTLIN,U,2)," ",$PIECE(WRTLIN,U,3)," ",$PIECE(WRTLIN,U,4)
+14 WRITE !,?5,$PIECE(WRTLIN,U,5),?22,$PIECE(WRTLIN,U,6),?26,$PIECE(WRTLIN,U,7),?38,$PIECE(WRTLIN,U,9)," ",$PIECE(WRTLIN,U,10)
+15 IF $PIECE(WRTLIN,U,11)'=""
WRITE !,?5,$PIECE(WRTLIN,U,11)," ",$PIECE(WRTLIN,U,12)," ",$PIECE(WRTLIN,U,13)," ",$PIECE(WRTLIN,U,14)," ",$PIECE(WRTLIN,U,15)
+16 IF $PIECE(WRTLIN,U,11)=""
WRITE !,?5,$PIECE(WRTLIN,U,12)," ",$PIECE(WRTLIN,U,13)," ",$PIECE(WRTLIN,U,14)," ",$PIECE(WRTLIN,U,15)
+17 WRITE !,?5,$PIECE(WRTLIN,U,16)," ",$PIECE(WRTLIN,U,17)," ",$PIECE(WRTLIN,U,18)
+18 WRITE !,?5,$PIECE(WRTLIN,U,19)," ",$PIECE(WRTLIN,U,20)," ",$PIECE(WRTLIN,U,21)
+19 WRITE !,?5,$PIECE(WRTLIN,U,22)," ",$PIECE(WRTLIN,U,23)," ",$PIECE(WRTLIN,U,24)
+20 WRITE !,?5,$PIECE(WRTLIN,U,25)," ",$PIECE(WRTLIN,U,26)," ",$PIECE(WRTLIN,U,27)
+21 WRITE !,?5,$PIECE(WRTLIN,U,28),?11,$PIECE(WRTLIN,U,29),?18,$PIECE(WRTLIN,U,30),?30,$PIECE(WRTLIN,U,31),?42,$PIECE(WRTLIN,U,32),?54,$PIECE(WRTLIN,U,33),?67,$PIECE(WRTLIN,U,34)
+22 WRITE ?79,$PIECE(WRTLIN,U,35),?90,$PIECE(WRTLIN,U,36),?102,$PIECE(WRTLIN,U,44),?106,$PIECE(WRTLIN,U,45),?110,$PIECE(WRTLIN,U,46),?121,$PIECE(WRTLIN,U,43)
+23 WRITE !,?5,$PIECE(WRTLIN,U,41),?87,$PIECE(WRTLIN,U,15)
+24 QUIT
HDR ;
+1 SET PAGE=PAGE+1
+2 WRITE @IOF
+3 WRITE "BT ELECTRONIC VOUCHER REPORT PRINT DATE: ",PDT,?(126-$LENGTH(PAGE)),"PAGE ",PAGE
+4 WRITE !,$$FMTE^XLFDT(STARTDT)," TO ",$$FMTE^XLFDT(ENDDT)
+5 WRITE !,"DIVISION: ",$SELECT(DGBTDIVN="ALL":"ALL",1:DGBTDIVI)
+6 WRITE !,$EXTRACT(EQUAL,1,127)
+7 WRITE !,"NAME",?32,"SSN",?45,"CLAIM DATE",?67,"ENTRY DATE",?81,"CLERK",?118,"ACCT"
+8 WRITE !,?5,"ADDRESS"
+9 WRITE !?5,"CITY",?22,"ST",?26,"ZIP",?38,"FACILITY"
+10 WRITE !,?5,"FACILITY ADDRESS"
+11 WRITE !,?5,"DEPARTURE"
+12 WRITE !,?5,"DEPARTURE"
+13 WRITE !,?5,"DESTINATION"
+14 WRITE !,?5,"DESTINATION"
+15 WRITE !,?5,"MILES",?11,"RATE",?18,"ALLOW",?30,"M&L",?42,"F&B",?54,"TOTAL",?67,"ECON",?79,"TOTAL",?90,"PAYABLE",?102,"1W",?106,"RT",?110,"DED",?121,"CC FEE"
+16 WRITE !,?5,"REMARKS",?87,"FISCAL SYMBOLS"
+17 WRITE !,$EXTRACT(EQUAL,1,127)
+18 QUIT
GTOT ;
+1 WRITE !,$EXTRACT(EQUAL,1,127)
+2 WRITE !,"GRAND TOTALS"
+3 WRITE !,"MILES",?7,"CLMS",?14,"ALLOW",?26,"M&L",?38,"F&B",?50,"TOTAL",?63,"ECON",?75,"TOTAL",?86,"PAYABLE",?98,"1W",?102,"RT",?106,"DED",?117,"CC FEE"
+4 WRITE !,GRAND("MILES"),?7,GRAND("CLAIMS"),?14,$$DLRAMT(GRAND("ALLOW")),?26,$$DLRAMT(GRAND("M&L")),?38,$$DLRAMT(GRAND("F&B")),?50,$$DLRAMT(GRAND("ALLOW TOT"))
+5 WRITE ?63,$$DLRAMT(GRAND("ECON")),?75,$$DLRAMT(GRAND("ECON TOT")),?86,$$DLRAMT(GRAND("PAYABLE")),?98,GRAND("1W"),?102,GRAND("RT")
+6 WRITE ?106,$$DLRAMT(GRAND("DED")),?117,$$DLRAMT(GRAND("CC FEE"))
+7 WRITE !,$EXTRACT(EQUAL,1,127)
+8 QUIT
DLRAMT(X) ;
+1 DO COMMA^%DTC
IF 'DGBTEXCEL
QUIT $TRANSLATE(X," ","")
+2 QUIT $TRANSLATE(X," ,$","")
