DGBTR125 ;ALB/RFE - SPECIAL MODE REPORT; 06/22/12
;;1.0;Beneficiary Travel;**20**;November 11, 2011;Build 185
Q
EN ;Entry point
N %,%Y,DATALINE,DENY,DFN,DGBTDIVN,DGBTEXC,DGBTQ,ENAME,ENDDT,ENTRY,EQUAL,GRAND,I,LINESP,LINEZERO,PAGE,PATNAME,PDT,POP,PROMPT,REPTYPE,SNAME,SQ1,SQ2
N STARTDT,X,X2,X3,Y,ZTQUEUED
D CLEAN^DILF
S X2="2$"
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
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" 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
.S DGBTDIVN=$O(^DG(40.8,0))
I (($D(DIRUT))!($D(DTOUT))!($D(DUOUT))) D CLEAN^DILF Q
F D Q:DONE
.S DONE=1
.K DIR S DIR("A")="START NAME",DIR("B")="AAA",DIR(0)="F^1:30^" D ^DIR K DIR
.I ($D(DIRUT))!($D(DIROUT)) Q
.S SNAME=$$UP^XLFSTR(Y)
.K DIR S DIR("A")="END NAME",DIR("B")="ZZZ",DIR(0)="F^1:30^" D ^DIR K DIR
.I ($D(DIRUT))!($D(DIROUT)) Q
.S ENAME=$$UP^XLFSTR(Y)
.I SNAME]ENAME W !,"START NAME CANNOT FOLLOW END NAME" S DONE=0 Q
K DONE
I ($D(DIRUT))!($D(DIROUT)) D CLEAN^DILF Q
K DIR
S DIR(0)="S^F:FULL;T:TOTAL",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 REPTYPE=Y
D SETPRT,QUIT
Q
SETPRT ;
S DGBTEXC=$$SELEXCEL^DGBTUTL
I DGBTEXC="^" Q
I 'DGBTEXC N COLWID S COLWID=132 D PRINTMSG^DGBTUTL
D DEVICE^DGBTUTL("Beneficiary Travel Special Mode Report","MAIN^DGBTR125(DGBTEXC,STARTDT,ENDDT,DGBTDIVN,SNAME,ENAME,REPTYPE)",DGBTEXC,132)
I $G(DGBTQ) Q
;
I $D(IO("Q")) D:'$D(ZTQUEUED) ^%ZISC Q
D MAIN(DGBTEXC,STARTDT,ENDDT,DGBTDIVN,SNAME,ENAME,REPTYPE)
D:'$D(ZTQUEUED) ^%ZISC
U IO
Q
MAIN(DGBTEXC,STARTDT,ENDDT,DGBTDIVN,SNAME,ENAME,REPTYPE) ;
K ^TMP("DGBTR125",$J)
D GETRECS
I '$D(^TMP("DGBTR125",$J)) W !,"No records found" D QUIT Q
D PRINT
Q
GETRECS ;
I REPTYPE="F" F I="CLAIMS","MILE","BASE RATE","MILEAGE FEE","NSNL","WAIT TIME","EXTRA CREW","SPECIAL EQUIPMENT","INVOICE AMT" S GRAND(I)=0
I REPTYPE="T" F I="PAID","DENIED","CLAIMS","NSNL","PAID AMT" 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 '$$DIV Q
S DATALINE=""
I $$GET1^DIQ(392,I,56,"I")'="S" Q
S DFN=$P(LINEZERO,U,2) Q:DFN=""
S PATNAME=$$GET1^DIQ(2,DFN,.01)
I '$$NMRNG^DGBTUTL(PATNAME,SNAME,ENAME,1) Q
S LINESP=$G(^DGBT(392,I,"SP"))
S DATALINE=""
I REPTYPE="F" D GLFULL
I REPTYPE="T" D GLTOTAL
I DATALINE'="" S ^TMP("DGBTR125",$J,SQ1,SQ2)=DATALINE
Q
DIV() ;
I DGBTDIVN="ALL" Q 1
Q $P(LINEZERO,U,11)=DGBTDIVN
GLFULL ; Special mode full
S SQ1=ENTRY
S SQ2=$O(^TMP("DGBTR125",$J,SQ1,""),-1)+1
S GRAND("CLAIMS")=GRAND("CLAIMS")+1
S $P(DATALINE,U)=PATNAME
S $P(DATALINE,U,2)=$$FMTE^XLFDT($P($P(LINEZERO,U),".")) ; Claim date/time
S $P(DATALINE,U,3)=$$GET1^DIQ(392.42,$P(LINESP,U),.01) ; Mode of transportation
S $P(DATALINE,U,4)=$P(LINESP,U,2) ; Invoice #
S $P(DATALINE,U,5)=$$FMTE^XLFDT($P(LINESP,U,3)) ; Invoice date
S $P(DATALINE,U,6)=$$GET1^DIQ(392,I,67,"I") ; One way/round trip
S $P(DATALINE,U,7)=$P(LINESP,U,12) ; Miles
S GRAND("MILE")=GRAND("MILE")+$P(LINESP,U,12)
S $P(DATALINE,U,8)=$$DLRAMT($P(LINESP,U,5)) ; Base rate fee
S GRAND("BASE RATE")=GRAND("BASE RATE")+$P(LINESP,U,5)
S $P(DATALINE,U,9)=$$DLRAMT($P(LINESP,U,6)) ; Mileage fee
S GRAND("MILEAGE FEE")=GRAND("MILEAGE FEE")+$P(LINESP,U,6)
S $P(DATALINE,U,10)=$$DLRAMT($P(LINESP,U,7)) ; No show/no load fee
S GRAND("NSNL")=GRAND("NSNL")+$P(LINESP,U,7)
S $P(DATALINE,U,11)=$$DLRAMT($P(LINESP,U,8)) ; Wait time fee
S GRAND("WAIT TIME")=GRAND("WAIT TIME")+$P(LINESP,U,8)
S $P(DATALINE,U,12)=$$DLRAMT($P(LINESP,U,9)) ; Extra crew fee
S GRAND("EXTRA CREW")=GRAND("EXTRA CREW")+$P(LINESP,U,9)
S $P(DATALINE,U,13)=$$DLRAMT($P(LINESP,U,10)) ; Special equipment fee
S GRAND("SPECIAL EQUIPMENT")=GRAND("SPECIAL EQUIPMENT")+$P(LINESP,U,10)
S $P(DATALINE,U,14)=$$DLRAMT($P(LINESP,U,4)) ; Total invoice amount
S GRAND("INVOICE AMT")=GRAND("INVOICE AMT")+$P(LINESP,U,4)
S $P(DATALINE,U,15)=$$GET1^DIQ(40.8,$P(LINEZERO,U,11),.01) ; Division
S $P(DATALINE,U,16)=$$GET1^DIQ(440,$P(LINESP,U,14),.01) ; Vendor
S $P(DATALINE,U,17)=$S($$GET1^DIQ(392,I,45.2,"I"):"D",1:"")
Q
GLTOTAL ; Special mode total
S SQ1=$P(LINEZERO,U,11)_"^"_$$GET1^DIQ(392.42,$P(LINESP,U),.01)
S SQ2=0
S DENY=$$GET1^DIQ(392,I,45.2,"I")
S DATALINE=$G(^TMP("DGBTR125",$J,SQ1,SQ2))
S $P(DATALINE,U)=$P(DATALINE,U)+$S(DENY:0,1:1) ;claims paid
I 'DENY S GRAND("PAID")=GRAND("PAID")+1
S $P(DATALINE,U,2)=$P(DATALINE,U,2)+$S(DENY:1,1:0) ; Claims denied
I DENY S GRAND("DENIED")=GRAND("DENIED")+1
S $P(DATALINE,U,3)=1+$P(DATALINE,U,3) ; Number of claims
S GRAND("CLAIMS")=GRAND("CLAIMS")+1
S $P(DATALINE,U,4)=$P(DATALINE,U,4)+$S('DENY:$P(LINESP,U,7),1:0) ; No show/no load
I 'DENY S GRAND("NSNL")=GRAND("NSNL")+$P(LINESP,U,7)
S $P(DATALINE,U,5)=$P(DATALINE,U,5)+$S('DENY:$P(LINESP,U,4),1:0) ; Invoice
I 'DENY S GRAND("PAID AMT")=GRAND("PAID AMT")+$P(LINESP,U,4)
Q
PRINT ;
U IO
S $P(EQUAL,"=",133)="",PAGE=0
D NOW^%DTC S Y=% D DD^%DT S PDT=Y
I 'DGBTEXC D
.I REPTYPE="F" D HDRFUL
.I REPTYPE="T" D HDRTOT
I DGBTEXC D
.I REPTYPE="F" D
..W "ENTRY DATE^PATIENT^CLAIM DATE^CC MODE^INV #^INV DT^R/O^MILES^BASE RATE^MILE FEE^NO SHOW NO LOAD^WAIT TIME^EXTRA CREW^SPECIAL EQUIPMENT^INV AMT^"
..W "DIVISION^VENDOR^STATUS"
.I REPTYPE="T" D
..W "DIVISION^# PAID^# DENIED ^BY MODE^NSNL^INVOICE PAID^MODE"
S (PROMPT,SQ1)=""
F S SQ1=$O(^TMP("DGBTR125",$J,SQ1)) Q:SQ1="" D Q:PROMPT="^"
.S SQ2=""
.F S SQ2=$O(^TMP("DGBTR125",$J,SQ1,SQ2)) Q:SQ2="" D Q:PROMPT="^"
..S DATALINE=^TMP("DGBTR125",$J,SQ1,SQ2)
..I DGBTEXC D PRTXL Q
..I ($Y+$S(REPTYPE="F":4,1:2))>IOSL D Q:PROMPT="^"
...I ($E(IOST,1)="C"),(IOSL'[99) R !,"Please press ENTER to continue or '^' to stop ",PROMPT:DTIME Q:PROMPT="^"
...I REPTYPE="F" D HDRFUL
...I REPTYPE="T" D HDRTOT
..I REPTYPE="F" D PRTFUL
..I REPTYPE="T" D PRTTOT
I 'DGBTEXC D
.I ($Y+4)<IOSL W !!!
.I REPTYPE="F" D GRANDFUL
.I REPTYPE="T" D GRANDTOT
I IOST["C-" S Y=$$PAUSE^DGBTUTL(DGBTEXC)
I IOST'["C-" W !,"REPORT HAS FINISHED"
Q
PRTXL ;
I REPTYPE="F" D
. W !,$$FMTE^XLFDT($P(SQ1,U)),U,DATALINE
I REPTYPE="T" D
.W !,$$GET1^DIQ(40.8,$P(SQ1,U),.01),U F I=1:1:3 W $P(DATALINE,U,I),U
.W $$DLRAMT($P(DATALINE,U,4)),U,$$DLRAMT($P(DATALINE,U,5)),U,$P(SQ1,U,2)
Q
PRTFUL ;
W !,$P(DATALINE,U),?32,$P(DATALINE,U,2),?52,$P(DATALINE,U,3),?84,$P(DATALINE,U,4),?116,$P(DATALINE,U,5)
W !,?5,$P(DATALINE,U,6),?17,$P(DATALINE,U,7),?27,$P(DATALINE,U,8),?42,$P(DATALINE,U,9),?52,$P(DATALINE,U,10),?63,$P(DATALINE,U,11)
W ?73,$P(DATALINE,U,12),?83,$P(DATALINE,U,13),?94,$P(DATALINE,U,14),?105,$$FMTE^XLFDT(SQ1)
W !,?5,$P(DATALINE,U,15),?37,$P(DATALINE,U,16),?75,$P(DATALINE,U,17)
Q
PRTTOT ;
W !,$$GET1^DIQ(40.8,$P(SQ1,U),.01),?37,$P(DATALINE,U),?43,$P(DATALINE,U,2),?51,$P(DATALINE,U,3),?59,$$DLRAMT($P(DATALINE,U,4))
W ?74,$$DLRAMT($P(DATALINE,U,5)),?90,$P(SQ1,U,2)
Q
HDRFUL ;
S PAGE=PAGE+1
W @IOF
W "BT SPECIAL MODE FULL REPORT PRINT DATE: ",PDT,?(126-$L(PAGE)),"PAGE ",PAGE
W !,$$FMTE^XLFDT(STARTDT)," TO ",$$FMTE^XLFDT(ENDDT)
W !,"FIRST VETERAN NAME: ",SNAME
W !,"LAST VETERAN NAME: ",ENAME
W !,"DIVISION: ",$S(DGBTDIVN="ALL":"ALL",1:$$GET1^DIQ(40.8,DGBTDIVN,.01))
W !,$E(EQUAL,1,128)
W !,"PATIENT NAME",?32,"CLAIM DATE",?52,"MODE",?84,"INV #",?116,"INVOICE DATE"
w !?5,"R/O",?17,"MILES",?27,"BASE RATE",?42,"MILEAGE",?52,"NSNL",?63,"WAIT FEE",?73,"EXT CREW",?83,"SPEC EQ",?94,"INV AMT",?105,"ENTRY DATE"
W !?5,"DIVISION",?37,"VENDOR",?75,"STATUS"
W !,$E(EQUAL,1,128)
Q
HDRTOT ;
S PAGE=PAGE+1
W @IOF
W "BT SPECIAL MODE TOTAL REPORT PRINT DATE: ",PDT,?(126-$L(PAGE)),"PAGE ",PAGE
W !,$$FMTE^XLFDT(STARTDT)," TO ",$$FMTE^XLFDT(ENDDT)
W !,"FIRST VETERAN NAME: ",SNAME
W !,"LAST VETERAN NAME: ",ENAME
W !,"DIVISION: ",$S(DGBTDIVN="ALL":"ALL",1:$$GET1^DIQ(40.8,DGBTDIVN,.01))
W !,$E(EQUAL,1,126)
W !,"DIVISION",?37,"PAID",?43,"DENIED",?51,"CLAIMS",?59,"NSNL",?74,"INV PAID",?90,"MODE"
W !,$E(EQUAL,1,126)
Q
GRANDFUL ;
I ($Y+5)>IOSL D
.S PAGE=PAGE+1
.W @IOF
.W "BT SPECIAL MODE FULL REPORT PRINT DATE: ",PDT,?(126-$L(PAGE)),"PAGE ",PAGE
.W !,$$FMTE^XLFDT(STARTDT)," TO ",$$FMTE^XLFDT(ENDDT)
.W !,"FIRST VETERAN NAME: ",SNAME
.W !,"LAST VETERAN NAME: ",ENAME
.W !,"DIVISION: ",$S(DGBTDIVN="ALL":"ALL",1:$$GET1^DIQ(40.8,DGBTDIVN,.01))
W !,$E(EQUAL,1,128)
W !,"GRAND TOTALS:",?17,"MILES",?27,"BASE RATE",?42,"MILEAGE",?52,"NSNL",?63,"WAIT FEE",?73,"EXT CREW",?83,"SPEC EQ",?94,"INV AMT",?105,"CLAIMS"
W !,?17,GRAND("MILE"),?27,$$DLRAMT(GRAND("BASE RATE")),?42,$$DLRAMT(GRAND("MILEAGE FEE")),?52,$$DLRAMT(GRAND("NSNL"))
W ?63,$$DLRAMT(GRAND("WAIT TIME")),?73,$$DLRAMT(GRAND("EXTRA CREW")),?83,$$DLRAMT(GRAND("SPECIAL EQUIPMENT"))
W ?94,$$DLRAMT(GRAND("INVOICE AMT")),?105,GRAND("CLAIMS")
W !,$E(EQUAL,1,128)
Q
GRANDTOT ;
I ($Y+5)>IOSL D
.S PAGE=PAGE+1
.W @IOF
.W "BT SPECIAL MODE TOTAL REPORT PRINT DATE: ",PDT,?(126-$L(PAGE)),"PAGE ",PAGE
.W !,$$FMTE^XLFDT(STARTDT)," TO ",$$FMTE^XLFDT(ENDDT)
.W !,"FIRST VETERAN NAME: ",SNAME
.W !,"LAST VETERAN NAME: ",ENAME
.W !,"DIVISION: ",$S(DGBTDIVN="ALL":"ALL",1:$$GET1^DIQ(40.8,DGBTDIVN,.01))
W !,$E(EQUAL,1,126)
W !,"GRAND TOTALS:",?37,"PAID",?43,"DENIED",?51,"CLAIMS",?59,"NSNL",?74,"INV PAID"
W !,?37,GRAND("PAID"),?43,GRAND("DENIED"),?51,GRAND("CLAIMS"),?59,$$DLRAMT(GRAND("NSNL")),?74,$$DLRAMT(GRAND("PAID AMT"))
W !,$E(EQUAL,1,126)
Q
DLRAMT(X) ;
D COMMA^%DTC I 'DGBTEXC Q $TR(X," ","")
Q $TR(X," ,$","")
QUIT ;
K ^TMP("DGBTR125",$J)
D CLEAN^DILF
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDGBTR125 10143 printed Sep 23, 2025@19:17 Page 2
DGBTR125 ;ALB/RFE - SPECIAL MODE REPORT; 06/22/12
+1 ;;1.0;Beneficiary Travel;**20**;November 11, 2011;Build 185
+2 QUIT
EN ;Entry point
+1 NEW %,%Y,DATALINE,DENY,DFN,DGBTDIVN,DGBTEXC,DGBTQ,ENAME,ENDDT,ENTRY,EQUAL,GRAND,I,LINESP,LINEZERO,PAGE,PATNAME,PDT,POP,PROMPT,REPTYPE,SNAME,SQ1,SQ2
+2 NEW STARTDT,X,X2,X3,Y,ZTQUEUED
+3 DO CLEAN^DILF
+4 SET X2="2$"
+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 Begin DoDot:1
+13 IF $$GET1^DIQ(43,1,11,"I")
Begin DoDot:2
+14 SET DGBTDIVN=$$YESNO^DGBTUTL("Do you wish to run this report for all divisions")
+15 IF DGBTDIVN
SET DGBTDIVN="ALL"
QUIT
+16 IF (($DATA(DIRUT))!($DATA(DTOUT))!($DATA(DUOUT)))
QUIT
+17 KILL DIR
SET DIR(0)="P^40.8:EMZ"
DO ^DIR
KILL DIR
+18 IF (($DATA(DIRUT))!($DATA(DTOUT))!($DATA(DUOUT)))
QUIT
+19 SET DGBTDIVN=+Y
End DoDot:2
QUIT
+20 SET DGBTDIVN=$ORDER(^DG(40.8,0))
End DoDot:1
+21 IF (($DATA(DIRUT))!($DATA(DTOUT))!($DATA(DUOUT)))
DO CLEAN^DILF
QUIT
+22 FOR
Begin DoDot:1
+23 SET DONE=1
+24 KILL DIR
SET DIR("A")="START NAME"
SET DIR("B")="AAA"
SET DIR(0)="F^1:30^"
DO ^DIR
KILL DIR
+25 IF ($DATA(DIRUT))!($DATA(DIROUT))
QUIT
+26 SET SNAME=$$UP^XLFSTR(Y)
+27 KILL DIR
SET DIR("A")="END NAME"
SET DIR("B")="ZZZ"
SET DIR(0)="F^1:30^"
DO ^DIR
KILL DIR
+28 IF ($DATA(DIRUT))!($DATA(DIROUT))
QUIT
+29 SET ENAME=$$UP^XLFSTR(Y)
+30 IF SNAME]ENAME
WRITE !,"START NAME CANNOT FOLLOW END NAME"
SET DONE=0
QUIT
End DoDot:1
if DONE
QUIT
+31 KILL DONE
+32 IF ($DATA(DIRUT))!($DATA(DIROUT))
DO CLEAN^DILF
QUIT
+33 KILL DIR
+34 SET DIR(0)="S^F:FULL;T:TOTAL"
SET DIR("A")="Which claim type do you want to run?"
DO ^DIR
KILL DIR
+35 IF (($DATA(DIRUT))!($DATA(DTOUT))!($DATA(DUOUT)))
DO CLEAN^DILF
QUIT
+36 SET REPTYPE=Y
+37 DO SETPRT
DO QUIT
+38 QUIT
SETPRT ;
+1 SET DGBTEXC=$$SELEXCEL^DGBTUTL
+2 IF DGBTEXC="^"
QUIT
+3 IF 'DGBTEXC
NEW COLWID
SET COLWID=132
DO PRINTMSG^DGBTUTL
+4 DO DEVICE^DGBTUTL("Beneficiary Travel Special Mode Report","MAIN^DGBTR125(DGBTEXC,STARTDT,ENDDT,DGBTDIVN,SNAME,ENAME,REPTYPE)",DGBTEXC,132)
+5 IF $GET(DGBTQ)
QUIT
+6 ;
+7 IF $DATA(IO("Q"))
if '$DATA(ZTQUEUED)
DO ^%ZISC
QUIT
+8 DO MAIN(DGBTEXC,STARTDT,ENDDT,DGBTDIVN,SNAME,ENAME,REPTYPE)
+9 if '$DATA(ZTQUEUED)
DO ^%ZISC
+10 USE IO
+11 QUIT
MAIN(DGBTEXC,STARTDT,ENDDT,DGBTDIVN,SNAME,ENAME,REPTYPE) ;
+1 KILL ^TMP("DGBTR125",$JOB)
+2 DO GETRECS
+3 IF '$DATA(^TMP("DGBTR125",$JOB))
WRITE !,"No records found"
DO QUIT
QUIT
+4 DO PRINT
+5 QUIT
GETRECS ;
+1 IF REPTYPE="F"
FOR I="CLAIMS","MILE","BASE RATE","MILEAGE FEE","NSNL","WAIT TIME","EXTRA CREW","SPECIAL EQUIPMENT","INVOICE AMT"
SET GRAND(I)=0
+2 IF REPTYPE="T"
FOR I="PAID","DENIED","CLAIMS","NSNL","PAID AMT"
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 IF '$$DIV
QUIT
+3 SET DATALINE=""
+4 IF $$GET1^DIQ(392,I,56,"I")'="S"
QUIT
+5 SET DFN=$PIECE(LINEZERO,U,2)
if DFN=""
QUIT
+6 SET PATNAME=$$GET1^DIQ(2,DFN,.01)
+7 IF '$$NMRNG^DGBTUTL(PATNAME,SNAME,ENAME,1)
QUIT
+8 SET LINESP=$GET(^DGBT(392,I,"SP"))
+9 SET DATALINE=""
+10 IF REPTYPE="F"
DO GLFULL
+11 IF REPTYPE="T"
DO GLTOTAL
+12 IF DATALINE'=""
SET ^TMP("DGBTR125",$JOB,SQ1,SQ2)=DATALINE
+13 QUIT
DIV() ;
+1 IF DGBTDIVN="ALL"
QUIT 1
+2 QUIT $PIECE(LINEZERO,U,11)=DGBTDIVN
GLFULL ; Special mode full
+1 SET SQ1=ENTRY
+2 SET SQ2=$ORDER(^TMP("DGBTR125",$JOB,SQ1,""),-1)+1
+3 SET GRAND("CLAIMS")=GRAND("CLAIMS")+1
+4 SET $PIECE(DATALINE,U)=PATNAME
+5 ; Claim date/time
SET $PIECE(DATALINE,U,2)=$$FMTE^XLFDT($PIECE($PIECE(LINEZERO,U),"."))
+6 ; Mode of transportation
SET $PIECE(DATALINE,U,3)=$$GET1^DIQ(392.42,$PIECE(LINESP,U),.01)
+7 ; Invoice #
SET $PIECE(DATALINE,U,4)=$PIECE(LINESP,U,2)
+8 ; Invoice date
SET $PIECE(DATALINE,U,5)=$$FMTE^XLFDT($PIECE(LINESP,U,3))
+9 ; One way/round trip
SET $PIECE(DATALINE,U,6)=$$GET1^DIQ(392,I,67,"I")
+10 ; Miles
SET $PIECE(DATALINE,U,7)=$PIECE(LINESP,U,12)
+11 SET GRAND("MILE")=GRAND("MILE")+$PIECE(LINESP,U,12)
+12 ; Base rate fee
SET $PIECE(DATALINE,U,8)=$$DLRAMT($PIECE(LINESP,U,5))
+13 SET GRAND("BASE RATE")=GRAND("BASE RATE")+$PIECE(LINESP,U,5)
+14 ; Mileage fee
SET $PIECE(DATALINE,U,9)=$$DLRAMT($PIECE(LINESP,U,6))
+15 SET GRAND("MILEAGE FEE")=GRAND("MILEAGE FEE")+$PIECE(LINESP,U,6)
+16 ; No show/no load fee
SET $PIECE(DATALINE,U,10)=$$DLRAMT($PIECE(LINESP,U,7))
+17 SET GRAND("NSNL")=GRAND("NSNL")+$PIECE(LINESP,U,7)
+18 ; Wait time fee
SET $PIECE(DATALINE,U,11)=$$DLRAMT($PIECE(LINESP,U,8))
+19 SET GRAND("WAIT TIME")=GRAND("WAIT TIME")+$PIECE(LINESP,U,8)
+20 ; Extra crew fee
SET $PIECE(DATALINE,U,12)=$$DLRAMT($PIECE(LINESP,U,9))
+21 SET GRAND("EXTRA CREW")=GRAND("EXTRA CREW")+$PIECE(LINESP,U,9)
+22 ; Special equipment fee
SET $PIECE(DATALINE,U,13)=$$DLRAMT($PIECE(LINESP,U,10))
+23 SET GRAND("SPECIAL EQUIPMENT")=GRAND("SPECIAL EQUIPMENT")+$PIECE(LINESP,U,10)
+24 ; Total invoice amount
SET $PIECE(DATALINE,U,14)=$$DLRAMT($PIECE(LINESP,U,4))
+25 SET GRAND("INVOICE AMT")=GRAND("INVOICE AMT")+$PIECE(LINESP,U,4)
+26 ; Division
SET $PIECE(DATALINE,U,15)=$$GET1^DIQ(40.8,$PIECE(LINEZERO,U,11),.01)
+27 ; Vendor
SET $PIECE(DATALINE,U,16)=$$GET1^DIQ(440,$PIECE(LINESP,U,14),.01)
+28 SET $PIECE(DATALINE,U,17)=$SELECT($$GET1^DIQ(392,I,45.2,"I"):"D",1:"")
+29 QUIT
GLTOTAL ; Special mode total
+1 SET SQ1=$PIECE(LINEZERO,U,11)_"^"_$$GET1^DIQ(392.42,$PIECE(LINESP,U),.01)
+2 SET SQ2=0
+3 SET DENY=$$GET1^DIQ(392,I,45.2,"I")
+4 SET DATALINE=$GET(^TMP("DGBTR125",$JOB,SQ1,SQ2))
+5 ;claims paid
SET $PIECE(DATALINE,U)=$PIECE(DATALINE,U)+$SELECT(DENY:0,1:1)
+6 IF 'DENY
SET GRAND("PAID")=GRAND("PAID")+1
+7 ; Claims denied
SET $PIECE(DATALINE,U,2)=$PIECE(DATALINE,U,2)+$SELECT(DENY:1,1:0)
+8 IF DENY
SET GRAND("DENIED")=GRAND("DENIED")+1
+9 ; Number of claims
SET $PIECE(DATALINE,U,3)=1+$PIECE(DATALINE,U,3)
+10 SET GRAND("CLAIMS")=GRAND("CLAIMS")+1
+11 ; No show/no load
SET $PIECE(DATALINE,U,4)=$PIECE(DATALINE,U,4)+$SELECT('DENY:$PIECE(LINESP,U,7),1:0)
+12 IF 'DENY
SET GRAND("NSNL")=GRAND("NSNL")+$PIECE(LINESP,U,7)
+13 ; Invoice
SET $PIECE(DATALINE,U,5)=$PIECE(DATALINE,U,5)+$SELECT('DENY:$PIECE(LINESP,U,4),1:0)
+14 IF 'DENY
SET GRAND("PAID AMT")=GRAND("PAID AMT")+$PIECE(LINESP,U,4)
+15 QUIT
PRINT ;
+1 USE IO
+2 SET $PIECE(EQUAL,"=",133)=""
SET PAGE=0
+3 DO NOW^%DTC
SET Y=%
DO DD^%DT
SET PDT=Y
+4 IF 'DGBTEXC
Begin DoDot:1
+5 IF REPTYPE="F"
DO HDRFUL
+6 IF REPTYPE="T"
DO HDRTOT
End DoDot:1
+7 IF DGBTEXC
Begin DoDot:1
+8 IF REPTYPE="F"
Begin DoDot:2
+9 WRITE "ENTRY DATE^PATIENT^CLAIM DATE^CC MODE^INV #^INV DT^R/O^MILES^BASE RATE^MILE FEE^NO SHOW NO LOAD^WAIT TIME^EXTRA CREW^SPECIAL EQUIPMENT^INV AMT^"
+10 WRITE "DIVISION^VENDOR^STATUS"
End DoDot:2
+11 IF REPTYPE="T"
Begin DoDot:2
+12 WRITE "DIVISION^# PAID^# DENIED ^BY MODE^NSNL^INVOICE PAID^MODE"
End DoDot:2
End DoDot:1
+13 SET (PROMPT,SQ1)=""
+14 FOR
SET SQ1=$ORDER(^TMP("DGBTR125",$JOB,SQ1))
if SQ1=""
QUIT
Begin DoDot:1
+15 SET SQ2=""
+16 FOR
SET SQ2=$ORDER(^TMP("DGBTR125",$JOB,SQ1,SQ2))
if SQ2=""
QUIT
Begin DoDot:2
+17 SET DATALINE=^TMP("DGBTR125",$JOB,SQ1,SQ2)
+18 IF DGBTEXC
DO PRTXL
QUIT
+19 IF ($Y+$SELECT(REPTYPE="F":4,1:2))>IOSL
Begin DoDot:3
+20 IF ($EXTRACT(IOST,1)="C")
IF (IOSL'[99)
READ !,"Please press ENTER to continue or '^' to stop ",PROMPT:DTIME
if PROMPT="^"
QUIT
+21 IF REPTYPE="F"
DO HDRFUL
+22 IF REPTYPE="T"
DO HDRTOT
End DoDot:3
if PROMPT="^"
QUIT
+23 IF REPTYPE="F"
DO PRTFUL
+24 IF REPTYPE="T"
DO PRTTOT
End DoDot:2
if PROMPT="^"
QUIT
End DoDot:1
if PROMPT="^"
QUIT
+25 IF 'DGBTEXC
Begin DoDot:1
+26 IF ($Y+4)<IOSL
WRITE !!!
+27 IF REPTYPE="F"
DO GRANDFUL
+28 IF REPTYPE="T"
DO GRANDTOT
End DoDot:1
+29 IF IOST["C-"
SET Y=$$PAUSE^DGBTUTL(DGBTEXC)
+30 IF IOST'["C-"
WRITE !,"REPORT HAS FINISHED"
+31 QUIT
PRTXL ;
+1 IF REPTYPE="F"
Begin DoDot:1
+2 WRITE !,$$FMTE^XLFDT($PIECE(SQ1,U)),U,DATALINE
End DoDot:1
+3 IF REPTYPE="T"
Begin DoDot:1
+4 WRITE !,$$GET1^DIQ(40.8,$PIECE(SQ1,U),.01),U
FOR I=1:1:3
WRITE $PIECE(DATALINE,U,I),U
+5 WRITE $$DLRAMT($PIECE(DATALINE,U,4)),U,$$DLRAMT($PIECE(DATALINE,U,5)),U,$PIECE(SQ1,U,2)
End DoDot:1
+6 QUIT
PRTFUL ;
+1 WRITE !,$PIECE(DATALINE,U),?32,$PIECE(DATALINE,U,2),?52,$PIECE(DATALINE,U,3),?84,$PIECE(DATALINE,U,4),?116,$PIECE(DATALINE,U,5)
+2 WRITE !,?5,$PIECE(DATALINE,U,6),?17,$PIECE(DATALINE,U,7),?27,$PIECE(DATALINE,U,8),?42,$PIECE(DATALINE,U,9),?52,$PIECE(DATALINE,U,10),?63,$PIECE(DATALINE,U,11)
+3 WRITE ?73,$PIECE(DATALINE,U,12),?83,$PIECE(DATALINE,U,13),?94,$PIECE(DATALINE,U,14),?105,$$FMTE^XLFDT(SQ1)
+4 WRITE !,?5,$PIECE(DATALINE,U,15),?37,$PIECE(DATALINE,U,16),?75,$PIECE(DATALINE,U,17)
+5 QUIT
PRTTOT ;
+1 WRITE !,$$GET1^DIQ(40.8,$PIECE(SQ1,U),.01),?37,$PIECE(DATALINE,U),?43,$PIECE(DATALINE,U,2),?51,$PIECE(DATALINE,U,3),?59,$$DLRAMT($PIECE(DATALINE,U,4))
+2 WRITE ?74,$$DLRAMT($PIECE(DATALINE,U,5)),?90,$PIECE(SQ1,U,2)
+3 QUIT
HDRFUL ;
+1 SET PAGE=PAGE+1
+2 WRITE @IOF
+3 WRITE "BT SPECIAL MODE FULL REPORT PRINT DATE: ",PDT,?(126-$LENGTH(PAGE)),"PAGE ",PAGE
+4 WRITE !,$$FMTE^XLFDT(STARTDT)," TO ",$$FMTE^XLFDT(ENDDT)
+5 WRITE !,"FIRST VETERAN NAME: ",SNAME
+6 WRITE !,"LAST VETERAN NAME: ",ENAME
+7 WRITE !,"DIVISION: ",$SELECT(DGBTDIVN="ALL":"ALL",1:$$GET1^DIQ(40.8,DGBTDIVN,.01))
+8 WRITE !,$EXTRACT(EQUAL,1,128)
+9 WRITE !,"PATIENT NAME",?32,"CLAIM DATE",?52,"MODE",?84,"INV #",?116,"INVOICE DATE"
+10 WRITE !?5,"R/O",?17,"MILES",?27,"BASE RATE",?42,"MILEAGE",?52,"NSNL",?63,"WAIT FEE",?73,"EXT CREW",?83,"SPEC EQ",?94,"INV AMT",?105,"ENTRY DATE"
+11 WRITE !?5,"DIVISION",?37,"VENDOR",?75,"STATUS"
+12 WRITE !,$EXTRACT(EQUAL,1,128)
+13 QUIT
HDRTOT ;
+1 SET PAGE=PAGE+1
+2 WRITE @IOF
+3 WRITE "BT SPECIAL MODE TOTAL REPORT PRINT DATE: ",PDT,?(126-$LENGTH(PAGE)),"PAGE ",PAGE
+4 WRITE !,$$FMTE^XLFDT(STARTDT)," TO ",$$FMTE^XLFDT(ENDDT)
+5 WRITE !,"FIRST VETERAN NAME: ",SNAME
+6 WRITE !,"LAST VETERAN NAME: ",ENAME
+7 WRITE !,"DIVISION: ",$SELECT(DGBTDIVN="ALL":"ALL",1:$$GET1^DIQ(40.8,DGBTDIVN,.01))
+8 WRITE !,$EXTRACT(EQUAL,1,126)
+9 WRITE !,"DIVISION",?37,"PAID",?43,"DENIED",?51,"CLAIMS",?59,"NSNL",?74,"INV PAID",?90,"MODE"
+10 WRITE !,$EXTRACT(EQUAL,1,126)
+11 QUIT
GRANDFUL ;
+1 IF ($Y+5)>IOSL
Begin DoDot:1
+2 SET PAGE=PAGE+1
+3 WRITE @IOF
+4 WRITE "BT SPECIAL MODE FULL REPORT PRINT DATE: ",PDT,?(126-$LENGTH(PAGE)),"PAGE ",PAGE
+5 WRITE !,$$FMTE^XLFDT(STARTDT)," TO ",$$FMTE^XLFDT(ENDDT)
+6 WRITE !,"FIRST VETERAN NAME: ",SNAME
+7 WRITE !,"LAST VETERAN NAME: ",ENAME
+8 WRITE !,"DIVISION: ",$SELECT(DGBTDIVN="ALL":"ALL",1:$$GET1^DIQ(40.8,DGBTDIVN,.01))
End DoDot:1
+9 WRITE !,$EXTRACT(EQUAL,1,128)
+10 WRITE !,"GRAND TOTALS:",?17,"MILES",?27,"BASE RATE",?42,"MILEAGE",?52,"NSNL",?63,"WAIT FEE",?73,"EXT CREW",?83,"SPEC EQ",?94,"INV AMT",?105,"CLAIMS"
+11 WRITE !,?17,GRAND("MILE"),?27,$$DLRAMT(GRAND("BASE RATE")),?42,$$DLRAMT(GRAND("MILEAGE FEE")),?52,$$DLRAMT(GRAND("NSNL"))
+12 WRITE ?63,$$DLRAMT(GRAND("WAIT TIME")),?73,$$DLRAMT(GRAND("EXTRA CREW")),?83,$$DLRAMT(GRAND("SPECIAL EQUIPMENT"))
+13 WRITE ?94,$$DLRAMT(GRAND("INVOICE AMT")),?105,GRAND("CLAIMS")
+14 WRITE !,$EXTRACT(EQUAL,1,128)
+15 QUIT
GRANDTOT ;
+1 IF ($Y+5)>IOSL
Begin DoDot:1
+2 SET PAGE=PAGE+1
+3 WRITE @IOF
+4 WRITE "BT SPECIAL MODE TOTAL REPORT PRINT DATE: ",PDT,?(126-$LENGTH(PAGE)),"PAGE ",PAGE
+5 WRITE !,$$FMTE^XLFDT(STARTDT)," TO ",$$FMTE^XLFDT(ENDDT)
+6 WRITE !,"FIRST VETERAN NAME: ",SNAME
+7 WRITE !,"LAST VETERAN NAME: ",ENAME
+8 WRITE !,"DIVISION: ",$SELECT(DGBTDIVN="ALL":"ALL",1:$$GET1^DIQ(40.8,DGBTDIVN,.01))
End DoDot:1
+9 WRITE !,$EXTRACT(EQUAL,1,126)
+10 WRITE !,"GRAND TOTALS:",?37,"PAID",?43,"DENIED",?51,"CLAIMS",?59,"NSNL",?74,"INV PAID"
+11 WRITE !,?37,GRAND("PAID"),?43,GRAND("DENIED"),?51,GRAND("CLAIMS"),?59,$$DLRAMT(GRAND("NSNL")),?74,$$DLRAMT(GRAND("PAID AMT"))
+12 WRITE !,$EXTRACT(EQUAL,1,126)
+13 QUIT
DLRAMT(X) ;
+1 DO COMMA^%DTC
IF 'DGBTEXC
QUIT $TRANSLATE(X," ","")
+2 QUIT $TRANSLATE(X," ,$","")
QUIT ;
+1 KILL ^TMP("DGBTR125",$JOB)
+2 DO CLEAN^DILF
+3 QUIT
