DGBTR121 ;ALB/RFE - SUMMARY REPORT; 05/02/12
;;1.0;Beneficiary Travel;**20**;November 11, 2011;Build 185
Q
EN ;Entry point
N %,%Y,CCFEE,DATALINE,DGBTEXCEL,DGBTDIV,DGBTDIVN,DGBTQ,ENDDT,ENTRY,EQUAL,GRAND,I,LINEM,LINESP,LINEZERO,PAGE,PDT,POP,PROMPT,STARTDT,SQ,TYPE,X,X2,Y
N ZTQUEUED
D CLEAN^DILF
S X2="2$",DGBTEXCEL=0
K DIR
S DIR("A")="START DATE: ",DIR(0)="DA^2991231:NOW:EX" D ^DIR K DIR
I ($D(DIRUT))!($D(DIROUT)) D CLEAN^DILF Q
S STARTDT=Y
S DIR("A")="END DATE: ",DIR(0)="DA^"_STARTDT_":NOW:EX" D ^DIR K DIR
I ($D(DIRUT))!($D(DIROUT)) D CLEAN^DILF Q
S ENDDT=Y
K DIR
S DIR(0)="S^M:MILEAGE;S:SPECIAL MODE",DIR("A")="Which claim type do you want to run?" D ^DIR K DIR
I (($D(DIRUT))!($D(DTOUT))!($D(DUOUT))) D CLEAN^DILF Q
S TYPE=Y
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" D CLEAN^DILF Q
D
.I $$GET1^DIQ(43,1,11,"I") D Q
..S DGBTDIVN=$$YESNO^DGBTUTL("Do you wish to run this report for all divisions")
..I DGBTDIVN S DGBTDIVN="ALL",DGBTDIV="" 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,DGBTDIV=$P(Y,U,2)
.S DGBTDIVN=$O(^DG(40.8,0)),DGBTDIV=$P(^DG(40.8,DGBTDIVN,0),U)
I (($D(DIRUT))!($D(DTOUT))!($D(DUOUT))) D CLEAN^DILF Q
D SETPRT,QUIT
Q
SETPRT ;
S DGBTEXCEL=$$SELEXCEL^DGBTUTL
I $G(DGBTEXCEL)="^" Q
I '$G(DGBTEXCEL) N COLWID S COLWID=132 D PRINTMSG^DGBTUTL
D DEVICE^DGBTUTL("Beneficiary Travel Summary Report","MAIN^DGBTR121(STARTDT,ENDDT,DGBTDIVN,DGBTDIV)")
;D DEVICE^DGBTUTL("Beneficiary Travel Summary Report","MAIN^DGBTR121",DGBTEXCEL,132)
I $G(DGBTQ) Q
;
I $D(IO("Q")) D:'$D(ZTQUEUED) ^%ZISC Q
D MAIN(STARTDT,ENDDT,DGBTDIVN,DGBTDIV)
D:'$D(ZTQUEUED) ^%ZISC
U IO
Q
MAIN(STARTDT,ENDDT,DGBTDIVN,DGBTDIV) ;
K ^TMP("DGBTRPS",$J)
D GETRECS
I '$D(^TMP("DGBTRPS",$J)) W !,"No records found" D QUIT Q
D PRINT
Q
GETRECS ;
I TYPE="M" F I="CLAIMS","MILEAGE","CC FEE","ECON","M&L","F&B","DED","PAY" S GRAND(I)=0
I TYPE="S" F I="CLAIMS","MILEAGE","BASE RATE","MILEAGE FEE","NSNL","WAIT TIME","EXTRA CREW","SPECIAL EQUIPMENT","INVOICE AMOUNT" S GRAND(I)=0
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="" D GETLINE
Q
GETLINE ;
S LINEZERO=$G(^DGBT(392,I,0))
I $$GET1^DIQ(392,I,45.2,"I") Q ;'="NO" Q
I '$$DIV Q
S SQ=$P(LINEZERO,U,13)_U_$P(LINEZERO,"^",11)_U_$P(LINEZERO,U,6)
S DATALINE=$G(^TMP("DGBTRPS",$J,SQ))
S $P(DATALINE,U)=1+$P(DATALINE,U) ; CLAIMS
I TYPE="M" D GLMILES Q
I TYPE="S" D GLSP Q
Q
DIV() ;
I DGBTDIVN="ALL" Q 1
Q $P(LINEZERO,U,11)=DGBTDIVN
GLMILES ;
I $$GET1^DIQ(392,I,56,"I")'="M" Q
S LINEM=$G(^DGBT(392,I,"M"))
S CCFEE=$$GET1^DIQ(392,I,55)
;S PAYABLE=$$PAYABLE
S GRAND("CLAIMS")=GRAND("CLAIMS")+1
S $P(DATALINE,U,2)=($P(LINEM,U)*$P(LINEM,U,2))+$P(DATALINE,U,2) ; MILEAGE
S GRAND("MILEAGE")=GRAND("MILEAGE")+($P(LINEM,U)*$P(LINEM,U,2))
S $P(DATALINE,U,3)=CCFEE+$P(DATALINE,U,3) ;COMMON CARRIER FEE
S GRAND("CC FEE")=GRAND("CC FEE")+$$GET1^DIQ(392,I,55)
S $P(DATALINE,U,4)=$P(LINEZERO,U,8)+$P(DATALINE,U,4) ; MOST ECONOMICAL COST
S GRAND("ECON")=GRAND("ECON")+$P(LINEZERO,U,8)
S $P(DATALINE,U,5)=$P(LINEM,U,4)+$P(DATALINE,U,5) ; MEALS & LODGING
S GRAND("M&L")=GRAND("M&L")+$P(LINEM,U,4)
S $P(DATALINE,U,6)=$P(LINEM,U,5)+$P(DATALINE,U,6) ; FERRIES & BRIDGES
S GRAND("F&B")=GRAND("F&B")+$P(LINEM,U,5)
S $P(DATALINE,U,7)=$P(LINEZERO,U,9)+$P(DATALINE,U,7) ; DEDUCTIBLE
S GRAND("DED")=GRAND("DED")+$P(LINEZERO,U,9)
S $P(DATALINE,U,8)=$P(LINEZERO,U,10)+$P(DATALINE,U,8) ; PAYABLE
S GRAND("PAY")=GRAND("PAY")+$P(LINEZERO,U,10)
S ^TMP("DGBTRPS",$J,SQ)=DATALINE
Q
GLSP ;
I $$GET1^DIQ(392,I,56,"I")'="S" Q
S LINESP=$G(^DGBT(392,I,"SP"))
S GRAND("CLAIMS")=GRAND("CLAIMS")+1
S $P(DATALINE,U,2)=$P(LINESP,U,12)+$P(DATALINE,U,2) ;MILEAGE
S GRAND("MILEAGE")=GRAND("MILEAGE")+$P(LINESP,U,12)
S $P(DATALINE,U,3)=$P(LINESP,U,5)+$P(DATALINE,U,3) ; BASE RATE FEE
S GRAND("BASE RATE")=GRAND("BASE RATE")+$P(LINESP,U,5)
S $P(DATALINE,U,4)=$P(LINESP,U,6)+$P(DATALINE,U,4) ; MILEAGE FEE
S GRAND("MILEAGE FEE")=GRAND("MILEAGE FEE")+$P(LINESP,U,6)
S $P(DATALINE,U,5)=$P(LINESP,U,7)+$P(DATALINE,U,5) ; NO LOAD/NO SHOW
S GRAND("NSNL")=GRAND("NSNL")+$P(LINESP,U,7)
S $P(DATALINE,U,6)=$P(LINESP,U,8)+$P(DATALINE,U,6) ; WAIT TIME
S GRAND("WAIT TIME")=GRAND("WAIT TIME")+$P(LINESP,U,8)
S $P(DATALINE,U,7)=$P(LINESP,U,9)+$P(DATALINE,U,7) ; EXTRA CREW
S GRAND("EXTRA CREW")=GRAND("EXTRA CREW")+$P(LINESP,U,9)
S $P(DATALINE,U,8)=$P(LINESP,U,10)+$P(DATALINE,U,8) ; SPECIAL EQUIPMENT
S GRAND("SPECIAL EQUIPMENT")=GRAND("SPECIAL EQUIPMENT")+$P(LINESP,U,10)
S $P(DATALINE,U,9)=$P(LINESP,U,4)+$P(DATALINE,U,9) ; TOTAL INVOICE AMOUNT
S GRAND("INVOICE AMOUNT")=GRAND("INVOICE AMOUNT")+$P(LINESP,U,4)
S ^TMP("DGBTRPS",$J,SQ)=DATALINE
Q
PRINT ;
U IO
I $G(DGBTEXCEL) D
.I TYPE="M" W "DATE ENTERED^DIVISION^ACCT^# CLAIMS^MILEAGE^CC FEE^MOST ECONOMIC^M & L^FERRIES AND BRIDGES^DEDUCTIBLE^AMOUNT PAYABLE" Q
.W "DATE ENTERED^DIVISION^ACCT^# CLAIMS^MILEAGE^BASE RATE^MILEAGE FEE^NO SHOW NO LOAD^WAIT TIME^EXTRA CREW^SPECIAL EQUPIMENT^INV AMT"
S (PROMPT,SQ)="",PAGE=0,$P(EQUAL,"=",133)=""
D NOW^%DTC S Y=% D DD^%DT S PDT=Y
I (TYPE="M")&('$G(DGBTEXCEL)) D HDRMIL
I (TYPE="S")&('$G(DGBTEXCEL)) D HDRSP
F S SQ=$O(^TMP("DGBTRPS",$J,SQ)) Q:SQ="" D Q:PROMPT="^"
.S DATALINE=^TMP("DGBTRPS",$J,SQ)
.I $G(DGBTEXCEL) D PRTXL Q
.I (TYPE="M")&(($Y+3)>IOSL) D Q:PROMPT="^"
..I ($E(IOST,1)="C"),(IOSL'[99) R !,"Please press return to continue or '^' to stop ",PROMPT:DTIME Q:PROMPT="^"
..D HDRMIL
.I (TYPE="S")&(($Y+3)>IOSL) D Q:PROMPT="^"
..I ($E(IOST,1)="C"),(IOSL'[99) R !,"Please press return to continue or '^' to stop ",PROMPT:DTIME Q:PROMPT="^"
..D HDRSP
.I TYPE="M" D
..W !,$S(DGBTDIV'="":DGBTDIV,1:$$GET1^DIQ(40.8,$P(SQ,U,2),.01)),?37,$$FMTE^XLFDT($P(SQ,U)),?50,$$GET1^DIQ(392.3,$P(SQ,U,3),2),?55,$P(DATALINE,U)
..W ?64,$P(DATALINE,U,2),?72,$$DLRAMT($P(DATALINE,U,3)),?87,$$DLRAMT($P(DATALINE,U,4)),?99,$$DLRAMT($P(DATALINE,U,5)),?112,$$DLRAMT($P(DATALINE,U,6))
..W !?5,$$DLRAMT($P(DATALINE,U,7)),?18,$$DLRAMT($P(DATALINE,U,8))
.I TYPE="S" D
..W !,$S(DGBTDIV'="":DGBTDIV,1:$$GET1^DIQ(40.8,$P(SQ,U,2),.01)),?37,$$FMTE^XLFDT($P(SQ,U)),?50,$$GET1^DIQ(392.3,$P(SQ,U,3),2),?55,$P(DATALINE,U)
..W ?64,$P(DATALINE,U,2),?72,$$DLRAMT($P(DATALINE,U,3)),?87,$$DLRAMT($P(DATALINE,U,4)),?99,$$DLRAMT($P(DATALINE,U,5)),?111,$$DLRAMT($P(DATALINE,U,6))
..W !,?5,$$DLRAMT($P(DATALINE,U,7)),?17,$$DLRAMT($P(DATALINE,U,8)),?29,$$DLRAMT($P(DATALINE,U,9))
I '$G(DGBTEXCEL) D
.I ($Y+4)<IOSL W !!!
.I TYPE="M" D GRANDMIL
.I TYPE="S" D GRANDSP
I IOST["C-" S DGBTQ=1 S Y=$$PAUSE^DGBTUTL(DGBTEXCEL)
I IOST'["C-" W !,"REPORT HAS FINISHED"
Q
PRTXL ;
W !,$$FMTE^XLFDT($P(SQ,U)),U,$S(DGBTDIV'="":DGBTDIV,1:$$GET1^DIQ(40.8,$P(SQ,U,2),.01)),U,$$GET1^DIQ(392.3,$P(SQ,U,3),2)
F I=1,2 W U,$P(DATALINE,U,I)
F I=3:1:$L(DATALINE,U) W U,$$DLRAMT($P(DATALINE,U,I))
Q
HDRMIL ;
S PAGE=PAGE+1
W @IOF
W "BT SUMMARY REPORT PRINT DATE: ",PDT,?(126-$L(PAGE)),"PAGE ",PAGE
W !,$$FMTE^XLFDT(STARTDT)," TO ",$$FMTE^XLFDT(ENDDT)
W !,"CLAIM TYPE: MILEAGE"
W !,"DIVISION: ",$S(DGBTDIVN="ALL":"ALL",1:DGBTDIV)
W !,$E(EQUAL,1,122)
W !,"DIVISION",?37,"ENTERED",?50,"ACCT",?55,"CLAIMS",?64,"MILEAGE",?72,"CC FEE",?87,"MOST ECON",?99,"M&L",?112,"F&B"
W !,?5,"DED",?18,"PAYABLE"
W !,$E(EQUAL,1,122)
Q
HDRSP ;
S PAGE=PAGE+1
W @IOF
W "BT SUMMARY REPORT PRINT DATE: ",PDT,?(126-$L(PAGE)),"PAGE ",PAGE
W !,$$FMTE^XLFDT(STARTDT)," TO ",$$FMTE^XLFDT(ENDDT)
W !,"CLAIM TYPE: SPECIAL MODE"
W !,"DIVISION: ",$S(DGBTDIVN="ALL":"ALL",1:DGBTDIV)
W !,$E(EQUAL,1,122)
W !,"DIVISION",?37,"ENTERED",?50,"ACCT",?55,"CLAIMS",?64,"MILEAGE",?72,"BASE RATE",?87,"MILEAGE FEE",?99,"NSNL",?111,"WAIT TIME"
W !,?5,"EXTRA CREW",?17,"SPEC EQ",?29,"INV AMT"
W !,$E(EQUAL,1,122)
Q
GRANDMIL ;
I ($Y+5)>IOSL D HDRMIL
W !,$E(EQUAL,1,122)
W !,?55,"CLAIMS",?64,"MILEAGE",?72,"CC FEE",?87,"MOST ECON",?99,"M&L",?112,"F&B"
W !,?5,"DED",?18,"PAYABLE"
W !,?55,GRAND("CLAIMS"),?64,GRAND("MILEAGE"),?72,$$DLRAMT(GRAND("CC FEE")),?87,$$DLRAMT(GRAND("ECON")),?99,$$DLRAMT(GRAND("M&L"))
W ?112,$$DLRAMT(GRAND("F&B")),!,?5,$$DLRAMT(GRAND("DED")),?18,$$DLRAMT(GRAND("PAY"))
W !,$E(EQUAL,1,122)
Q
GRANDSP ;
I ($Y+5)>IOSL D HDRSP
W !,$E(EQUAL,1,122)
W !,"GRAND TOTALS:",?55,GRAND("CLAIMS"),?64,GRAND("MILEAGE"),?72,$$DLRAMT(GRAND("BASE RATE")),?87,$$DLRAMT(GRAND("MILEAGE FEE"))
W ?99,$$DLRAMT(GRAND("NSNL")),?111,$$DLRAMT(GRAND("WAIT TIME")),!,?5,$$DLRAMT(GRAND("EXTRA CREW")),?17,$$DLRAMT(GRAND("SPECIAL EQUIPMENT"))
W ?29,$$DLRAMT(GRAND("INVOICE AMOUNT"))
W !,$E(EQUAL,1,122)
Q
DLRAMT(X) ;
D COMMA^%DTC I '$G(DGBTEXCEL) Q $TR(X," ","")
Q $TR(X," ,$","")
QUIT ;
K ^TMP("DGBTRPS",$J)
D CLEAN^DILF
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDGBTR121 9065 printed Nov 22, 2024@16:51:09 Page 2
DGBTR121 ;ALB/RFE - SUMMARY REPORT; 05/02/12
+1 ;;1.0;Beneficiary Travel;**20**;November 11, 2011;Build 185
+2 QUIT
EN ;Entry point
+1 NEW %,%Y,CCFEE,DATALINE,DGBTEXCEL,DGBTDIV,DGBTDIVN,DGBTQ,ENDDT,ENTRY,EQUAL,GRAND,I,LINEM,LINESP,LINEZERO,PAGE,PDT,POP,PROMPT,STARTDT,SQ,TYPE,X,X2,Y
+2 NEW ZTQUEUED
+3 DO CLEAN^DILF
+4 SET X2="2$"
SET DGBTEXCEL=0
+5 KILL DIR
+6 SET DIR("A")="START DATE: "
SET DIR(0)="DA^2991231:NOW:EX"
DO ^DIR
KILL DIR
+7 IF ($DATA(DIRUT))!($DATA(DIROUT))
DO CLEAN^DILF
QUIT
+8 SET STARTDT=Y
+9 SET DIR("A")="END DATE: "
SET DIR(0)="DA^"_STARTDT_":NOW:EX"
DO ^DIR
KILL DIR
+10 IF ($DATA(DIRUT))!($DATA(DIROUT))
DO CLEAN^DILF
QUIT
+11 SET ENDDT=Y
+12 KILL DIR
+13 SET DIR(0)="S^M:MILEAGE;S:SPECIAL MODE"
SET DIR("A")="Which claim type do you want to run?"
DO ^DIR
KILL DIR
+14 IF (($DATA(DIRUT))!($DATA(DTOUT))!($DATA(DUOUT)))
DO CLEAN^DILF
QUIT
+15 SET TYPE=Y
+16 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"
DO CLEAN^DILF
QUIT
+17 Begin DoDot:1
+18 IF $$GET1^DIQ(43,1,11,"I")
Begin DoDot:2
+19 SET DGBTDIVN=$$YESNO^DGBTUTL("Do you wish to run this report for all divisions")
+20 IF DGBTDIVN
SET DGBTDIVN="ALL"
SET DGBTDIV=""
QUIT
+21 IF (($DATA(DIRUT))!($DATA(DTOUT))!($DATA(DUOUT)))
QUIT
+22 KILL DIR
SET DIR(0)="P^40.8:EMZ"
DO ^DIR
KILL DIR
+23 IF (($DATA(DIRUT))!($DATA(DTOUT))!($DATA(DUOUT)))
QUIT
+24 SET DGBTDIVN=+Y
SET DGBTDIV=$PIECE(Y,U,2)
End DoDot:2
QUIT
+25 SET DGBTDIVN=$ORDER(^DG(40.8,0))
SET DGBTDIV=$PIECE(^DG(40.8,DGBTDIVN,0),U)
End DoDot:1
+26 IF (($DATA(DIRUT))!($DATA(DTOUT))!($DATA(DUOUT)))
DO CLEAN^DILF
QUIT
+27 DO SETPRT
DO QUIT
+28 QUIT
SETPRT ;
+1 SET DGBTEXCEL=$$SELEXCEL^DGBTUTL
+2 IF $GET(DGBTEXCEL)="^"
QUIT
+3 IF '$GET(DGBTEXCEL)
NEW COLWID
SET COLWID=132
DO PRINTMSG^DGBTUTL
+4 DO DEVICE^DGBTUTL("Beneficiary Travel Summary Report","MAIN^DGBTR121(STARTDT,ENDDT,DGBTDIVN,DGBTDIV)")
+5 ;D DEVICE^DGBTUTL("Beneficiary Travel Summary Report","MAIN^DGBTR121",DGBTEXCEL,132)
+6 IF $GET(DGBTQ)
QUIT
+7 ;
+8 IF $DATA(IO("Q"))
if '$DATA(ZTQUEUED)
DO ^%ZISC
QUIT
+9 DO MAIN(STARTDT,ENDDT,DGBTDIVN,DGBTDIV)
+10 if '$DATA(ZTQUEUED)
DO ^%ZISC
+11 USE IO
+12 QUIT
MAIN(STARTDT,ENDDT,DGBTDIVN,DGBTDIV) ;
+1 KILL ^TMP("DGBTRPS",$JOB)
+2 DO GETRECS
+3 IF '$DATA(^TMP("DGBTRPS",$JOB))
WRITE !,"No records found"
DO QUIT
QUIT
+4 DO PRINT
+5 QUIT
GETRECS ;
+1 IF TYPE="M"
FOR I="CLAIMS","MILEAGE","CC FEE","ECON","M&L","F&B","DED","PAY"
SET GRAND(I)=0
+2 IF TYPE="S"
FOR I="CLAIMS","MILEAGE","BASE RATE","MILEAGE FEE","NSNL","WAIT TIME","EXTRA CREW","SPECIAL EQUIPMENT","INVOICE AMOUNT"
SET GRAND(I)=0
+3 SET ENTRY=$ORDER(^DGBT(392,"D",STARTDT),-1)
+4 FOR
SET ENTRY=$ORDER(^DGBT(392,"D",ENTRY))
if ENTRY=""
QUIT
if ENTRY>ENDDT
QUIT
Begin DoDot:1
+5 SET I=""
+6 FOR
SET I=$ORDER(^DGBT(392,"D",ENTRY,I))
if I=""
QUIT
DO GETLINE
End DoDot:1
+7 QUIT
GETLINE ;
+1 SET LINEZERO=$GET(^DGBT(392,I,0))
+2 ;'="NO" Q
IF $$GET1^DIQ(392,I,45.2,"I")
QUIT
+3 IF '$$DIV
QUIT
+4 SET SQ=$PIECE(LINEZERO,U,13)_U_$PIECE(LINEZERO,"^",11)_U_$PIECE(LINEZERO,U,6)
+5 SET DATALINE=$GET(^TMP("DGBTRPS",$JOB,SQ))
+6 ; CLAIMS
SET $PIECE(DATALINE,U)=1+$PIECE(DATALINE,U)
+7 IF TYPE="M"
DO GLMILES
QUIT
+8 IF TYPE="S"
DO GLSP
QUIT
+9 QUIT
DIV() ;
+1 IF DGBTDIVN="ALL"
QUIT 1
+2 QUIT $PIECE(LINEZERO,U,11)=DGBTDIVN
GLMILES ;
+1 IF $$GET1^DIQ(392,I,56,"I")'="M"
QUIT
+2 SET LINEM=$GET(^DGBT(392,I,"M"))
+3 SET CCFEE=$$GET1^DIQ(392,I,55)
+4 ;S PAYABLE=$$PAYABLE
+5 SET GRAND("CLAIMS")=GRAND("CLAIMS")+1
+6 ; MILEAGE
SET $PIECE(DATALINE,U,2)=($PIECE(LINEM,U)*$PIECE(LINEM,U,2))+$PIECE(DATALINE,U,2)
+7 SET GRAND("MILEAGE")=GRAND("MILEAGE")+($PIECE(LINEM,U)*$PIECE(LINEM,U,2))
+8 ;COMMON CARRIER FEE
SET $PIECE(DATALINE,U,3)=CCFEE+$PIECE(DATALINE,U,3)
+9 SET GRAND("CC FEE")=GRAND("CC FEE")+$$GET1^DIQ(392,I,55)
+10 ; MOST ECONOMICAL COST
SET $PIECE(DATALINE,U,4)=$PIECE(LINEZERO,U,8)+$PIECE(DATALINE,U,4)
+11 SET GRAND("ECON")=GRAND("ECON")+$PIECE(LINEZERO,U,8)
+12 ; MEALS & LODGING
SET $PIECE(DATALINE,U,5)=$PIECE(LINEM,U,4)+$PIECE(DATALINE,U,5)
+13 SET GRAND("M&L")=GRAND("M&L")+$PIECE(LINEM,U,4)
+14 ; FERRIES & BRIDGES
SET $PIECE(DATALINE,U,6)=$PIECE(LINEM,U,5)+$PIECE(DATALINE,U,6)
+15 SET GRAND("F&B")=GRAND("F&B")+$PIECE(LINEM,U,5)
+16 ; DEDUCTIBLE
SET $PIECE(DATALINE,U,7)=$PIECE(LINEZERO,U,9)+$PIECE(DATALINE,U,7)
+17 SET GRAND("DED")=GRAND("DED")+$PIECE(LINEZERO,U,9)
+18 ; PAYABLE
SET $PIECE(DATALINE,U,8)=$PIECE(LINEZERO,U,10)+$PIECE(DATALINE,U,8)
+19 SET GRAND("PAY")=GRAND("PAY")+$PIECE(LINEZERO,U,10)
+20 SET ^TMP("DGBTRPS",$JOB,SQ)=DATALINE
+21 QUIT
GLSP ;
+1 IF $$GET1^DIQ(392,I,56,"I")'="S"
QUIT
+2 SET LINESP=$GET(^DGBT(392,I,"SP"))
+3 SET GRAND("CLAIMS")=GRAND("CLAIMS")+1
+4 ;MILEAGE
SET $PIECE(DATALINE,U,2)=$PIECE(LINESP,U,12)+$PIECE(DATALINE,U,2)
+5 SET GRAND("MILEAGE")=GRAND("MILEAGE")+$PIECE(LINESP,U,12)
+6 ; BASE RATE FEE
SET $PIECE(DATALINE,U,3)=$PIECE(LINESP,U,5)+$PIECE(DATALINE,U,3)
+7 SET GRAND("BASE RATE")=GRAND("BASE RATE")+$PIECE(LINESP,U,5)
+8 ; MILEAGE FEE
SET $PIECE(DATALINE,U,4)=$PIECE(LINESP,U,6)+$PIECE(DATALINE,U,4)
+9 SET GRAND("MILEAGE FEE")=GRAND("MILEAGE FEE")+$PIECE(LINESP,U,6)
+10 ; NO LOAD/NO SHOW
SET $PIECE(DATALINE,U,5)=$PIECE(LINESP,U,7)+$PIECE(DATALINE,U,5)
+11 SET GRAND("NSNL")=GRAND("NSNL")+$PIECE(LINESP,U,7)
+12 ; WAIT TIME
SET $PIECE(DATALINE,U,6)=$PIECE(LINESP,U,8)+$PIECE(DATALINE,U,6)
+13 SET GRAND("WAIT TIME")=GRAND("WAIT TIME")+$PIECE(LINESP,U,8)
+14 ; EXTRA CREW
SET $PIECE(DATALINE,U,7)=$PIECE(LINESP,U,9)+$PIECE(DATALINE,U,7)
+15 SET GRAND("EXTRA CREW")=GRAND("EXTRA CREW")+$PIECE(LINESP,U,9)
+16 ; SPECIAL EQUIPMENT
SET $PIECE(DATALINE,U,8)=$PIECE(LINESP,U,10)+$PIECE(DATALINE,U,8)
+17 SET GRAND("SPECIAL EQUIPMENT")=GRAND("SPECIAL EQUIPMENT")+$PIECE(LINESP,U,10)
+18 ; TOTAL INVOICE AMOUNT
SET $PIECE(DATALINE,U,9)=$PIECE(LINESP,U,4)+$PIECE(DATALINE,U,9)
+19 SET GRAND("INVOICE AMOUNT")=GRAND("INVOICE AMOUNT")+$PIECE(LINESP,U,4)
+20 SET ^TMP("DGBTRPS",$JOB,SQ)=DATALINE
+21 QUIT
PRINT ;
+1 USE IO
+2 IF $GET(DGBTEXCEL)
Begin DoDot:1
+3 IF TYPE="M"
WRITE "DATE ENTERED^DIVISION^ACCT^# CLAIMS^MILEAGE^CC FEE^MOST ECONOMIC^M & L^FERRIES AND BRIDGES^DEDUCTIBLE^AMOUNT PAYABLE"
QUIT
+4 WRITE "DATE ENTERED^DIVISION^ACCT^# CLAIMS^MILEAGE^BASE RATE^MILEAGE FEE^NO SHOW NO LOAD^WAIT TIME^EXTRA CREW^SPECIAL EQUPIMENT^INV AMT"
End DoDot:1
+5 SET (PROMPT,SQ)=""
SET PAGE=0
SET $PIECE(EQUAL,"=",133)=""
+6 DO NOW^%DTC
SET Y=%
DO DD^%DT
SET PDT=Y
+7 IF (TYPE="M")&('$GET(DGBTEXCEL))
DO HDRMIL
+8 IF (TYPE="S")&('$GET(DGBTEXCEL))
DO HDRSP
+9 FOR
SET SQ=$ORDER(^TMP("DGBTRPS",$JOB,SQ))
if SQ=""
QUIT
Begin DoDot:1
+10 SET DATALINE=^TMP("DGBTRPS",$JOB,SQ)
+11 IF $GET(DGBTEXCEL)
DO PRTXL
QUIT
+12 IF (TYPE="M")&(($Y+3)>IOSL)
Begin DoDot:2
+13 IF ($EXTRACT(IOST,1)="C")
IF (IOSL'[99)
READ !,"Please press return to continue or '^' to stop ",PROMPT:DTIME
if PROMPT="^"
QUIT
+14 DO HDRMIL
End DoDot:2
if PROMPT="^"
QUIT
+15 IF (TYPE="S")&(($Y+3)>IOSL)
Begin DoDot:2
+16 IF ($EXTRACT(IOST,1)="C")
IF (IOSL'[99)
READ !,"Please press return to continue or '^' to stop ",PROMPT:DTIME
if PROMPT="^"
QUIT
+17 DO HDRSP
End DoDot:2
if PROMPT="^"
QUIT
+18 IF TYPE="M"
Begin DoDot:2
+19 WRITE !,$SELECT(DGBTDIV'="":DGBTDIV,1:$$GET1^DIQ(40.8,$PIECE(SQ,U,2),.01)),?37,$$FMTE^XLFDT($PIECE(SQ,U)),?50,$$GET1^DIQ(392.3,$PIECE(SQ,U,3),2),?55,$PIECE(DATALINE,U)
+20 WRITE ?64,$PIECE(DATALINE,U,2),?72,$$DLRAMT($PIECE(DATALINE,U,3)),?87,$$DLRAMT($PIECE(DATALINE,U,4)),?99,$$DLRAMT($PIECE(DATALINE,U,5)),?112,$$DLRAMT($PIECE(DATALINE,U,6))
+21 WRITE !?5,$$DLRAMT($PIECE(DATALINE,U,7)),?18,$$DLRAMT($PIECE(DATALINE,U,8))
End DoDot:2
+22 IF TYPE="S"
Begin DoDot:2
+23 WRITE !,$SELECT(DGBTDIV'="":DGBTDIV,1:$$GET1^DIQ(40.8,$PIECE(SQ,U,2),.01)),?37,$$FMTE^XLFDT($PIECE(SQ,U)),?50,$$GET1^DIQ(392.3,$PIECE(SQ,U,3),2),?55,$PIECE(DATALINE,U)
+24 WRITE ?64,$PIECE(DATALINE,U,2),?72,$$DLRAMT($PIECE(DATALINE,U,3)),?87,$$DLRAMT($PIECE(DATALINE,U,4)),?99,$$DLRAMT($PIECE(DATALINE,U,5)),?111,$$DLRAMT($PIECE(DATALINE,U,6))
+25 WRITE !,?5,$$DLRAMT($PIECE(DATALINE,U,7)),?17,$$DLRAMT($PIECE(DATALINE,U,8)),?29,$$DLRAMT($PIECE(DATALINE,U,9))
End DoDot:2
End DoDot:1
if PROMPT="^"
QUIT
+26 IF '$GET(DGBTEXCEL)
Begin DoDot:1
+27 IF ($Y+4)<IOSL
WRITE !!!
+28 IF TYPE="M"
DO GRANDMIL
+29 IF TYPE="S"
DO GRANDSP
End DoDot:1
+30 IF IOST["C-"
SET DGBTQ=1
SET Y=$$PAUSE^DGBTUTL(DGBTEXCEL)
+31 IF IOST'["C-"
WRITE !,"REPORT HAS FINISHED"
+32 QUIT
PRTXL ;
+1 WRITE !,$$FMTE^XLFDT($PIECE(SQ,U)),U,$SELECT(DGBTDIV'="":DGBTDIV,1:$$GET1^DIQ(40.8,$PIECE(SQ,U,2),.01)),U,$$GET1^DIQ(392.3,$PIECE(SQ,U,3),2)
+2 FOR I=1,2
WRITE U,$PIECE(DATALINE,U,I)
+3 FOR I=3:1:$LENGTH(DATALINE,U)
WRITE U,$$DLRAMT($PIECE(DATALINE,U,I))
+4 QUIT
HDRMIL ;
+1 SET PAGE=PAGE+1
+2 WRITE @IOF
+3 WRITE "BT SUMMARY REPORT PRINT DATE: ",PDT,?(126-$LENGTH(PAGE)),"PAGE ",PAGE
+4 WRITE !,$$FMTE^XLFDT(STARTDT)," TO ",$$FMTE^XLFDT(ENDDT)
+5 WRITE !,"CLAIM TYPE: MILEAGE"
+6 WRITE !,"DIVISION: ",$SELECT(DGBTDIVN="ALL":"ALL",1:DGBTDIV)
+7 WRITE !,$EXTRACT(EQUAL,1,122)
+8 WRITE !,"DIVISION",?37,"ENTERED",?50,"ACCT",?55,"CLAIMS",?64,"MILEAGE",?72,"CC FEE",?87,"MOST ECON",?99,"M&L",?112,"F&B"
+9 WRITE !,?5,"DED",?18,"PAYABLE"
+10 WRITE !,$EXTRACT(EQUAL,1,122)
+11 QUIT
HDRSP ;
+1 SET PAGE=PAGE+1
+2 WRITE @IOF
+3 WRITE "BT SUMMARY REPORT PRINT DATE: ",PDT,?(126-$LENGTH(PAGE)),"PAGE ",PAGE
+4 WRITE !,$$FMTE^XLFDT(STARTDT)," TO ",$$FMTE^XLFDT(ENDDT)
+5 WRITE !,"CLAIM TYPE: SPECIAL MODE"
+6 WRITE !,"DIVISION: ",$SELECT(DGBTDIVN="ALL":"ALL",1:DGBTDIV)
+7 WRITE !,$EXTRACT(EQUAL,1,122)
+8 WRITE !,"DIVISION",?37,"ENTERED",?50,"ACCT",?55,"CLAIMS",?64,"MILEAGE",?72,"BASE RATE",?87,"MILEAGE FEE",?99,"NSNL",?111,"WAIT TIME"
+9 WRITE !,?5,"EXTRA CREW",?17,"SPEC EQ",?29,"INV AMT"
+10 WRITE !,$EXTRACT(EQUAL,1,122)
+11 QUIT
GRANDMIL ;
+1 IF ($Y+5)>IOSL
DO HDRMIL
+2 WRITE !,$EXTRACT(EQUAL,1,122)
+3 WRITE !,?55,"CLAIMS",?64,"MILEAGE",?72,"CC FEE",?87,"MOST ECON",?99,"M&L",?112,"F&B"
+4 WRITE !,?5,"DED",?18,"PAYABLE"
+5 WRITE !,?55,GRAND("CLAIMS"),?64,GRAND("MILEAGE"),?72,$$DLRAMT(GRAND("CC FEE")),?87,$$DLRAMT(GRAND("ECON")),?99,$$DLRAMT(GRAND("M&L"))
+6 WRITE ?112,$$DLRAMT(GRAND("F&B")),!,?5,$$DLRAMT(GRAND("DED")),?18,$$DLRAMT(GRAND("PAY"))
+7 WRITE !,$EXTRACT(EQUAL,1,122)
+8 QUIT
GRANDSP ;
+1 IF ($Y+5)>IOSL
DO HDRSP
+2 WRITE !,$EXTRACT(EQUAL,1,122)
+3 WRITE !,"GRAND TOTALS:",?55,GRAND("CLAIMS"),?64,GRAND("MILEAGE"),?72,$$DLRAMT(GRAND("BASE RATE")),?87,$$DLRAMT(GRAND("MILEAGE FEE"))
+4 WRITE ?99,$$DLRAMT(GRAND("NSNL")),?111,$$DLRAMT(GRAND("WAIT TIME")),!,?5,$$DLRAMT(GRAND("EXTRA CREW")),?17,$$DLRAMT(GRAND("SPECIAL EQUIPMENT"))
+5 WRITE ?29,$$DLRAMT(GRAND("INVOICE AMOUNT"))
+6 WRITE !,$EXTRACT(EQUAL,1,122)
+7 QUIT
DLRAMT(X) ;
+1 DO COMMA^%DTC
IF '$GET(DGBTEXCEL)
QUIT $TRANSLATE(X," ","")
+2 QUIT $TRANSLATE(X," ,$","")
QUIT ;
+1 KILL ^TMP("DGBTRPS",$JOB)
+2 DO CLEAN^DILF
+3 QUIT
