DGBTR123 ;ALB/RFE - CLERK REPORT; 06/04/12
;;1.0;Beneficiary Travel;**20**;November 11, 2011;Build 185
Q
EN ;Entry point
N %,%Y,CCFEE,CLERK,CLERKALL,CLERKNAME,DATALINE,DFN,DGBTDIVN,DGBTEXC,DGBTQ,EQUAL,ENDDT,ENTRY,GRAND,I,LINEM,LINESP,LINEZERO,PAGE,PDT,PATZERO,POP
N PROMPT,REPTYPE,SQ1,SQ2,STARTDT,SUBS,TYPE,X,X2,X3,Y,ZTQUEUED
D CLEAN^DILF
S X2="2$",DGBTEXC=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
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
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 CLERKALL=$$YESNO^DGBTUTL("Do you wish to run this report for all clerks")
I (($D(DIRUT))!($D(DTOUT))!($D(DUOUT))) D CLEAN^DILF Q
S CLERK=""
I 'CLERKALL D
.K DIR S DIR(0)="P^200:EMZ",DIR("A")="Select CLERK" D ^DIR K DIR
.I (($D(DIRUT))!($D(DTOUT))!($D(DUOUT))) Q
.S CLERK=$P(Y,U)
I (($D(DIRUT))!($D(DTOUT))!($D(DUOUT))) 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
S SUBS=DGBTEXC_U_STARTDT_U_ENDDT_U_DGBTDIVN_U_TYPE_U_REPTYPE_U_CLERKALL_U_CLERK
I 'DGBTEXC N COLWID S COLWID=132 D PRINTMSG^DGBTUTL
D DEVICE^DGBTUTL("Beneficiary Travel Clerk Report","MAIN^DGBTR123(SUBS)",DGBTEXC,132)
I $G(DGBTQ) Q
;
I $D(IO("Q")) D:'$D(ZTQUEUED) ^%ZISC Q
D MAIN(SUBS)
D:'$D(ZTQUEUED) ^%ZISC
U IO
Q
MAIN(SUBS) ;
K ^TMP("DGBTRPTC",$J)
S DGBTEXC=$P(SUBS,U)
S STARTDT=$P(SUBS,U,2)
S ENDDT=$P(SUBS,U,3)
S DGBTDIVN=$P(SUBS,U,4)
S TYPE=$P(SUBS,U,5)
S REPTYPE=$P(SUBS,U,6)
S CLERKALL=$P(SUBS,U,7)
S CLERK=$P(SUBS,U,8)
S CLERKNAME=$$GET1^DIQ(200,CLERK,.01)
D GETRECS
I '$D(^TMP("DGBTRPTC",$J)) W !,"No records found" D QUIT Q
D PRINT
Q
GETRECS ;
I ((TYPE="M")&(REPTYPE="F")) F I="CLAIMS","TOT MILE","CC FEE","ECON","M&L","F&B","DED","PAY" S GRAND(I)=0
I ((TYPE="M")&(REPTYPE="T")) F I="MILE","CC FEE","ECON","M&L","F&B","DED","PAY" S GRAND(I)=0
I ((TYPE="S")&(REPTYPE="F")) F I="CLAIMS","MILE","BASE RATE","NSNL","WAIT TIME","EXTRA CREW","SPECIAL EQUIPMENT","INVOICE AMT" S GRAND(I)=0
I ((TYPE="S")&(REPTYPE="T")) F I="CLAIMS","MILE","BASE RATE","NSNL","WAIT TIME","EXTRA CREW","SPECIAL EQUIPMENT","INVOICE 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)) Q:'$$CLERK
I $$GET1^DIQ(392,I,45.2,"I") Q ;'="NO" Q
I '$$DIV Q
S DATALINE=""
S SQ1=$P(LINEZERO,"^",13)_"^"_$P(LINEZERO,"^",12)
I TYPE="M" D GLMILE
I TYPE="S" D GLSP
I DATALINE'="" S ^TMP("DGBTRPTC",$J,SQ1,SQ2)=DATALINE
Q
DIV() ;
I DGBTDIVN="ALL" Q 1
Q $P(LINEZERO,U,11)=DGBTDIVN
CLERK() ;
I CLERKALL Q 1
Q $P(LINEZERO,"^",12)=CLERK
GLMILE ;
I $$GET1^DIQ(392,I,56,"I")'="M" Q
S LINEM=$G(^DGBT(392,I,"M"))
S CCFEE=$$GET1^DIQ(392,$P(LINEZERO,U),55)
I REPTYPE="F" D GLMILEF
I REPTYPE="T" D GLMILET
Q
GLMILEF ; Mileage full
S SQ2=$O(^TMP("DGBTRPTC",$J,SQ1,""),-1)+1
S DFN=$P(LINEZERO,U,2) Q:DFN=""
S PATZERO=$G(^DPT(DFN,0))
S DATALINE=$P(PATZERO,U) ; Pat name
S GRAND("CLAIMS")=GRAND("CLAIMS")+1
S $P(DATALINE,U,2)=$P(PATZERO,U,9) ; Pat ID
S $P(DATALINE,U,3)=$$FMTE^XLFDT($P($P(LINEZERO,U),".")) ; Claim date/time
I DGBTEXC S $P(DATALINE,U,3)=$P($P(DATALINE,U,3),"@")
S $P(DATALINE,U,4)=$$GET1^DIQ(40.8,$P(LINEZERO,U,11),.01) ; Division
S $P(DATALINE,U,5)=$$GET1^DIQ(392.3,$P(LINEZERO,U,6),2) ; Account
S $P(DATALINE,U,6)=$S($P(LINEM,U)=1:"O",1:"R")
S $P(DATALINE,U,7)=$P(LINEM,U)*$P(LINEM,U,2) ; Total mileage
S GRAND("TOT MILE")=GRAND("TOT MILE")+($P(LINEM,U)*$P(LINEM,U,2))
S $P(DATALINE,U,8)=$$GET1^DIQ(392,$P(LINEZERO,U),44) ; Common carrier mode
S $P(DATALINE,U,9)=$$DLRAMT(CCFEE) ; Common carrier fee
S GRAND("CC FEE")=GRAND("CC FEE")+$$GET1^DIQ(392,$P(LINEZERO,U),55)
S $P(DATALINE,U,10)=$$DLRAMT($P(LINEZERO,U,8)) ; Most economical cost
S GRAND("ECON")=GRAND("ECON")+$P(LINEZERO,U,8)
S $P(DATALINE,U,11)=$$DLRAMT($P(LINEM,U,4)) ; Meals & lodging
S GRAND("M&L")=GRAND("M&L")+$P(LINEM,U,4)
S $P(DATALINE,U,12)=$$DLRAMT($P(LINEM,U,5)) ; Ferries & bridges
S GRAND("F&B")=GRAND("F&B")+$P(LINEM,U,5)
S $P(DATALINE,U,13)=$$DLRAMT($P(LINEZERO,U,9)) ; Deductible
S GRAND("DED")=GRAND("DED")+$P(LINEZERO,U,9)
S $P(DATALINE,U,14)=$$DLRAMT($P(LINEZERO,U,10)) ; Payable
S GRAND("PAY")=GRAND("PAY")+$P(LINEZERO,U,10)
S $P(DATALINE,U,15)=$TR($$GET1^DIQ(392,$P(LINEZERO,U),51),"^","") ; Remarks
Q
GLMILET ; Mileage total
S $P(SQ1,"^",3)=$P(LINEZERO,U,11)
S $P(SQ1,"^",4)=$P(LINEZERO,U,6)
S SQ2=0
S DATALINE=$G(^TMP("DGBTRPTC",$J,SQ1,SQ2))
S $P(DATALINE,U)=($P(LINEM,U)*$P(LINEM,U,2))+$P(DATALINE,U) ; MILEAGE
S $P(DATALINE,U,2)=$$GET1^DIQ(392,I,55)+$P(DATALINE,U,2) ;COMMON CARRIER FEE
S GRAND("CC FEE")=GRAND("CC FEE")+CCFEE
S $P(DATALINE,U,3)=$P(LINEZERO,U,8)+$P(DATALINE,U,3) ; MOST ECONOMICAL COST
S GRAND("ECON")=GRAND("ECON")+$P(LINEZERO,U,8)
S $P(DATALINE,U,4)=$P(LINEM,U,4)+$P(DATALINE,U,4) ; MEALS & LODGING
S GRAND("M&L")=GRAND("M&L")+$P(LINEM,U,4)
S $P(DATALINE,U,5)=$P(LINEM,U,5)+$P(DATALINE,U,5) ; FERRIES & BRIDGES
S GRAND("F&B")=GRAND("F&B")+$P(LINEM,U,5)
S $P(DATALINE,U,6)=$P(LINEZERO,U,9)+$P(DATALINE,U,6) ; DEDUCTIBLE
S GRAND("DED")=GRAND("DED")+$P(LINEZERO,U,9)
S $P(DATALINE,U,7)=$P(LINEZERO,U,10)+$P(DATALINE,U,7) ; PAYABLE
S GRAND("PAY")=GRAND("PAY")+$P(LINEZERO,U,10)
Q
GLSP ;
I $$GET1^DIQ(392,I,56,"I")'="S" Q
S LINESP=$G(^DGBT(392,I,"SP"))
I REPTYPE="F" D GLSPF
I REPTYPE="T" D GLSPT
Q
GLSPF ; Special mode full
S SQ2=$O(^TMP("DGBTRPTC",$J,SQ1,""),-1)+1
S DFN=$P(LINEZERO,U,2) Q:DFN=""
S PATZERO=$G(^DPT(DFN,0))
S DATALINE=$P(PATZERO,U) ; Pat name
S GRAND("CLAIMS")=GRAND("CLAIMS")+1
S $P(DATALINE,U,2)=$P(PATZERO,U,9) ; Pat ID
S $P(DATALINE,U,3)=$$FMTE^XLFDT($P($P(LINEZERO,U),".")) ; Claim date/time
I DGBTEXC S $P(DATALINE,U,3)=$P($P(DATALINE,U,3),"@")
S $P(DATALINE,U,4)=$$GET1^DIQ(40.8,$P(LINEZERO,U,11),.01) ; Division
S $P(DATALINE,U,5)=$$GET1^DIQ(392.3,$P(LINEZERO,U,6),2) ; Account
S $P(DATALINE,U,6)=$P(LINESP,U,12) ; Mileage
S GRAND("MILE")=GRAND("MILE")+$P(LINESP,U,12)
S $P(DATALINE,U,7)=$$DLRAMT($P(LINESP,U,5)) ; Base rate fee
S GRAND("BASE RATE")=GRAND("BASE RATE")+$P(LINESP,U,5)
S $P(DATALINE,U,8)=$$DLRAMT($P(LINESP,U,7)) ; No show/no load fee
S GRAND("NSNL")=GRAND("NSNL")+$P(LINESP,U,7)
S $P(DATALINE,U,9)=$$DLRAMT($P(LINESP,U,8)) ; Wait time fee
S GRAND("WAIT TIME")=GRAND("WAIT TIME")+$P(LINESP,U,8)
S $P(DATALINE,U,10)=$$DLRAMT($P(LINESP,U,9)) ; Extra crew fee
S GRAND("EXTRA CREW")=GRAND("EXTRA CREW")+$P(LINESP,U,9)
S $P(DATALINE,U,11)=$$DLRAMT($P(LINESP,U,10)) ; Special equipment fee
S GRAND("SPECIAL EQUIPMENT")=GRAND("SPECIAL EQUIPMENT")+$P(LINESP,U,10)
S $P(DATALINE,U,12)=$$DLRAMT($P(LINESP,U,4)) ; Invoice
S GRAND("INVOICE AMT")=GRAND("INVOICE AMT")+$P(LINESP,U,4)
S $P(DATALINE,U,13)=$TR($P(LINESP,U,26),"^","") ; Remarks
Q
GLSPT ; Special mode total
S $P(SQ1,"^",3)=$P(LINEZERO,U,11)
S $P(SQ1,"^",4)=$P(LINEZERO,U,6)
S SQ2=0
S DATALINE=$G(^TMP("DGBTRPTC",$J,SQ1,SQ2))
S $P(DATALINE,U)=1+$P(DATALINE,U) ; TOTAL CLAIMS
S GRAND("CLAIMS")=GRAND("CLAIMS")+1
S $P(DATALINE,U,2)=$P(LINESP,U,12)+$P(DATALINE,U,2) ; MILEAGE
S GRAND("MILE")=GRAND("MILE")+$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,7)+$P(DATALINE,U,4) ; NO LOAD/NO SHOW
S GRAND("NSNL")=GRAND("NSNL")+$P(LINESP,U,7)
S $P(DATALINE,U,5)=$P(LINESP,U,8)+$P(DATALINE,U,5) ; WAIT TIME
S GRAND("WAIT TIME")=GRAND("WAIT TIME")+$P(LINESP,U,8)
S $P(DATALINE,U,6)=$P(LINESP,U,9)+$P(DATALINE,U,6) ; EXTRA CREW
S GRAND("EXTRA CREW")=GRAND("EXTRA CREW")+$P(LINESP,U,9)
S $P(DATALINE,U,7)=$P(LINESP,U,10)+$P(DATALINE,U,7) ; SPECIAL EQUIPMENT
S GRAND("SPECIAL EQUIPMENT")=GRAND("SPECIAL EQUIPMENT")+$P(LINESP,U,10)
S $P(DATALINE,U,8)=$P(LINESP,U,4)+$P(DATALINE,U,8) ; TOTAL INVOICE AMOUNT
S GRAND("INVOICE AMT")=GRAND("INVOICE AMT")+$P(LINESP,U,4)
Q
PRINT ;
U IO
S PAGE=0,$P(EQUAL,"=",133)=""
D NOW^%DTC S Y=% D DD^%DT S PDT=Y
I DGBTEXC D
.I (TYPE="M")&(REPTYPE="F") D
..W "DATE ENTERED^PATIENT^PATIENT ID^CLERK^CLAIM DATE^DIVISION^ACCT^R/O^MILEAGE^CC MODE^CC FEE^MOST ECONOMIC^M & L^FERRIES & BRIDGES^DEDUCTIBLE^AMOUNT PAYABLE^REMARK"
.I (TYPE="M")&(REPTYPE="T") D
..W "DATE ENTERED^CLERK^DIVISION^ACCT^MILEAGE^CC FEE^MOST ECONOMIC^M & L^FERRIES &BRIDGES^DEDUCTIBLE^AMOUNT PAYABLE"
.I (TYPE="S")&(REPTYPE="F") D
..W "DATE ENTERED^PATIENT^PATIENT ID^CLERK^CLAIM DATE^DIVISION^ACCT^MILEAGE^BASE RATE^NO SHOW NO LOAD^WAIT TIME^EXTRA CREW^SPECIAL EQUIPMENT^INVOICE AMOUNT^REMARK"
.I (TYPE="S")&(REPTYPE="T") D
..W "DATE ENTERED^CLERK^DIVISION^ACCT^# CLAIMS^MILEAGE^BASE RATE^NO SHOW NO LOAD^WAIT TIME^EXTRA CREW^SPECIAL EQUIPMENT^INVOICE AMOUNT"
I (TYPE="M")&(REPTYPE="F")&('DGBTEXC) D HDRMF^DGBTR3A
I (TYPE="M")&(REPTYPE="T")&('DGBTEXC) D HDRMT
I (TYPE="S")&(REPTYPE="F")&('DGBTEXC) D HDRSF
I (TYPE="S")&(REPTYPE="T")&('DGBTEXC) D HDRST
S (PROMPT,SQ1)=""
F S SQ1=$O(^TMP("DGBTRPTC",$J,SQ1)) Q:SQ1="" D Q:PROMPT="^"
.S SQ2=""
.F S SQ2=$O(^TMP("DGBTRPTC",$J,SQ1,SQ2)) Q:SQ2="" D Q:PROMPT="^"
..S DATALINE=^TMP("DGBTRPTC",$J,SQ1,SQ2)
..I DGBTEXC D PRTXL Q
..I (TYPE="M")&(REPTYPE="F")&(($Y+4)>IOSL) D Q:PROMPT="^"
...D HDRMF^DGBTR3A
..I (TYPE="M")&(REPTYPE="F") D
...W !,$P(DATALINE,U),?32,$P(DATALINE,U,2),?43,$$GET1^DIQ(200,$P(SQ1,U,2),.01),?78,$P(DATALINE,U,3),?92,$$FMTE^XLFDT($P(SQ1,U))
...W ?109,$P(DATALINE,U,5)
...W !,?5,$P(DATALINE,U,4),?42,$P(DATALINE,U,6),?48,$P(DATALINE,U,7),?54,$P(DATALINE,U,8),?92,$P(DATALINE,U,9),?107,$P(DATALINE,U,10)
...W ?119,$P(DATALINE,U,11)
...W !,?5,$P(DATALINE,U,12),?17,$P(DATALINE,U,13),?25,$P(DATALINE,U,14),?38,$P(DATALINE,U,15)
..I (TYPE="S")&(REPTYPE="F")&(($Y+4)>IOSL) D Q:PROMPT="^"
...D HDRSF
..I (TYPE="S")&(REPTYPE="F") D
...W !,$P(DATALINE,U),?32,$P(DATALINE,U,2),?43,$$GET1^DIQ(200,$P(SQ1,U,2),.01),?78,$P(DATALINE,U,3),?92,$$FMTE^XLFDT($P(SQ1,U))
...W ?109,$P(DATALINE,U,5)
...W !,?5,$P(DATALINE,U,4),?42,$P(DATALINE,U,6),?50,$P(DATALINE,U,7),?65,$P(DATALINE,U,8),?79,$P(DATALINE,U,9),?90,$P(DATALINE,U,10)
...W ?102,$P(DATALINE,U,11),?116,$P(DATALINE,U,12)
...W !,?5,$P(DATALINE,U,13)
..I (TYPE="M")&(REPTYPE="T")&(($Y+3)>IOSL) D Q:PROMPT="^"
...D HDRMT
..I (TYPE="M")&(REPTYPE="T") D
...W !,$$GET1^DIQ(40.8,$P(SQ1,U,3),.01),?37,$$FMTE^XLFDT($P(SQ1,U)),?50,$$GET1^DIQ(392.3,$P(SQ1,U,4),2),?55,$P(DATALINE,U)
...W ?63,$$DLRAMT($P(DATALINE,U,2)),?78,$$DLRAMT($P(DATALINE,U,3)),?90,$$DLRAMT($P(DATALINE,U,4)),?103,$$DLRAMT($P(DATALINE,U,5))
...W !,?5,$$DLRAMT($P(DATALINE,U,6)),?18,$$DLRAMT($P(DATALINE,U,7)),?29,$$GET1^DIQ(200,$P(SQ1,U,2),.01)
..I (TYPE="S")&(REPTYPE="T")&(($Y+3)>IOSL) D Q:PROMPT="^"
...D HDRST
..I (TYPE="S")&(REPTYPE="T") D
...W !,$$GET1^DIQ(40.8,$P(SQ1,U,3),.01),?37,$$FMTE^XLFDT($P(SQ1,U)),?50,$$GET1^DIQ(392.3,$P(SQ1,U,4),2),?55,$P(DATALINE,U,2)
...W ?63,$P(DATALINE,U),?72,$$DLRAMT($P(DATALINE,U,3)),?87,$$DLRAMT($P(DATALINE,U,4)),?102,$$DLRAMT($P(DATALINE,U,5))
...W ?117,$$DLRAMT($P(DATALINE,U,6))
...W !,?5,$$DLRAMT($P(DATALINE,U,7)),?15,$$DLRAMT($P(DATALINE,U,8)),?25,$$GET1^DIQ(200,$P(SQ1,U,2),.01)
..Q
I 'DGBTEXC D
.I ($Y+4)<IOSL W !!!
.I (REPTYPE="F"),(TYPE="M") D GRANDMF^DGBTR3A
.I (REPTYPE="T"),(TYPE="M") D GRANDMT^DGBTR3A
.I (REPTYPE="F"),(TYPE="S") D GRANDSF^DGBTR3A
.I (REPTYPE="T"),(TYPE="S") D GRANDST^DGBTR3A
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,$P(DATALINE,U),U,$P(DATALINE,U,2),U,$$GET1^DIQ(200,$P(SQ1,U,2),.01) F I=3:1:$L(DATALINE,U) W U,$P(DATALINE,U,I)
I REPTYPE="T" D
.W !,$$FMTE^XLFDT($P(SQ1,U)),U,$$GET1^DIQ(200,$P(SQ1,U,2),.01),U,$$GET1^DIQ(40.8,$P(SQ1,U,3),.01),U,$$GET1^DIQ(392.3,$P(SQ1,U,4),2)
.I TYPE="M" D
..W U,$P(DATALINE,U,1)
..F I=2:1:$L(DATALINE,U) W U,$$DLRAMT($P(DATALINE,U,I))
.I TYPE="S" D
..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
DLRAMT(X) ;
D COMMA^%DTC I 'DGBTEXC Q $TR(X," ","")
Q $TR(X," ,$","")
HDRMT ;
S PAGE=PAGE+1
W @IOF
W "BT CLERK REPORT PRINT DATE: ",PDT,?(126-$L(PAGE)),"PAGE ",PAGE
W !,$$FMTE^XLFDT(STARTDT)," TO ",$$FMTE^XLFDT(ENDDT)
W !,"VERSION: TOTAL"
W !,"TYPE: MILEAGE"
W !,"DIVISION: ",$S(DGBTDIVN="ALL":"ALL",1:$$GET1^DIQ(40.8,DGBTDIVN,.01))
W !,"CLERK: ",$S(CLERKALL:"ALL",1:CLERKNAME)
W !,$E(EQUAL,1,117)
W !,"DIVISION",?37,"ENTERED",?50,"ACCT",?55,"MILEAGE",?63,"CC FEE",?78,"MOST ECON",?90,"M&L",?103,"F&B"
W !,?5,"DED",?18,"PAYABLE",?29,"CLERK"
W !,$E(EQUAL,1,117)
Q
HDRSF ;
S PAGE=PAGE+1
W @IOF
W "BT CLERK REPORT PRINT DATE: ",PDT,?(126-$L(PAGE)),"PAGE ",PAGE
W !,$$FMTE^XLFDT(STARTDT)," TO ",$$FMTE^XLFDT(ENDDT)
W !,"VERSION: FULL"
W !,"TYPE: SPECIAL MODE"
W !,"DIVISION: ",$S(DGBTDIVN="ALL":"ALL",1:$$GET1^DIQ(40.8,DGBTDIVN,.01))
W !,"CLERK: ",$S(CLERKALL:"ALL",1:CLERKNAME)
W !,$E(EQUAL,1,124)
W !,"PATIENT NAME",?32,"SSN",?43,"CLERK",?78,"CL DT",?92,"ENT DT",?109,"ACCT"
W !,?5,"DIVISION",?42,"MILEAGE",?50,"BASE RATE",?65,"NSNL",?79,"WAIT TIME",?90,"EX CREW",?102,"SPEC EQ",?116,"INV AMT"
W !,?5,"REMARKS"
W !,$E(EQUAL,1,124)
Q
HDRST ;
S PAGE=PAGE+1
W @IOF
W "BT CLERK REPORT PRINT DATE: ",PDT,?(126-$L(PAGE)),"PAGE ",PAGE
W !,$$FMTE^XLFDT(STARTDT)," TO ",$$FMTE^XLFDT(ENDDT)
W !,"VERSION: TOTAL"
W !,"TYPE: SPECIAL MODE"
W !,"DIVISION: ",$S(DGBTDIVN="ALL":"ALL",1:$$GET1^DIQ(40.8,DGBTDIVN,.01))
W !,"CLERK: ",$S(CLERKALL:"ALL",1:CLERKNAME)
W !,$E(EQUAL,1,127)
W !,"DIVISION",?37,"ENTERED",?50,"ACCT",?55,"MILEAGE",?63,"CLAIMS",?72,"BASE RATE",?87,"NSNL",?102,"WAIT TIME",?117,"EXTRA CREW"
W !,?5,"SPEC EQ",?15,"INV AMT",?25,"CLERK"
W !,$E(EQUAL,1,127)
Q
QUIT ;
K ^TMP("DGBTRPTC",$J)
D CLEAN^DILF
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDGBTR123 14835 printed Dec 13, 2024@01:40:59 Page 2
DGBTR123 ;ALB/RFE - CLERK REPORT; 06/04/12
+1 ;;1.0;Beneficiary Travel;**20**;November 11, 2011;Build 185
+2 QUIT
EN ;Entry point
+1 NEW %,%Y,CCFEE,CLERK,CLERKALL,CLERKNAME,DATALINE,DFN,DGBTDIVN,DGBTEXC,DGBTQ,EQUAL,ENDDT,ENTRY,GRAND,I,LINEM,LINESP,LINEZERO,PAGE,PDT,PATZERO,POP
+2 NEW PROMPT,REPTYPE,SQ1,SQ2,STARTDT,SUBS,TYPE,X,X2,X3,Y,ZTQUEUED
+3 DO CLEAN^DILF
+4 SET X2="2$"
SET DGBTEXC=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 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 KILL DIR
+23 SET DIR(0)="S^M:MILEAGE;S:SPECIAL MODE"
SET DIR("A")="Which claim type do you want to run?"
DO ^DIR
KILL DIR
+24 IF (($DATA(DIRUT))!($DATA(DTOUT))!($DATA(DUOUT)))
DO CLEAN^DILF
QUIT
+25 SET TYPE=Y
+26 SET CLERKALL=$$YESNO^DGBTUTL("Do you wish to run this report for all clerks")
+27 IF (($DATA(DIRUT))!($DATA(DTOUT))!($DATA(DUOUT)))
DO CLEAN^DILF
QUIT
+28 SET CLERK=""
+29 IF 'CLERKALL
Begin DoDot:1
+30 KILL DIR
SET DIR(0)="P^200:EMZ"
SET DIR("A")="Select CLERK"
DO ^DIR
KILL DIR
+31 IF (($DATA(DIRUT))!($DATA(DTOUT))!($DATA(DUOUT)))
QUIT
+32 SET CLERK=$PIECE(Y,U)
End DoDot:1
+33 IF (($DATA(DIRUT))!($DATA(DTOUT))!($DATA(DUOUT)))
DO CLEAN^DILF
QUIT
+34 KILL DIR
+35 SET DIR(0)="S^F:FULL;T:TOTAL"
SET DIR("A")="Which claim type do you want to run?"
DO ^DIR
KILL DIR
+36 IF (($DATA(DIRUT))!($DATA(DTOUT))!($DATA(DUOUT)))
DO CLEAN^DILF
QUIT
+37 SET REPTYPE=Y
+38 DO SETPRT
DO QUIT
+39 QUIT
SETPRT ;
+1 SET DGBTEXC=$$SELEXCEL^DGBTUTL
+2 IF DGBTEXC="^"
QUIT
+3 SET SUBS=DGBTEXC_U_STARTDT_U_ENDDT_U_DGBTDIVN_U_TYPE_U_REPTYPE_U_CLERKALL_U_CLERK
+4 IF 'DGBTEXC
NEW COLWID
SET COLWID=132
DO PRINTMSG^DGBTUTL
+5 DO DEVICE^DGBTUTL("Beneficiary Travel Clerk Report","MAIN^DGBTR123(SUBS)",DGBTEXC,132)
+6 IF $GET(DGBTQ)
QUIT
+7 ;
+8 IF $DATA(IO("Q"))
if '$DATA(ZTQUEUED)
DO ^%ZISC
QUIT
+9 DO MAIN(SUBS)
+10 if '$DATA(ZTQUEUED)
DO ^%ZISC
+11 USE IO
+12 QUIT
MAIN(SUBS) ;
+1 KILL ^TMP("DGBTRPTC",$JOB)
+2 SET DGBTEXC=$PIECE(SUBS,U)
+3 SET STARTDT=$PIECE(SUBS,U,2)
+4 SET ENDDT=$PIECE(SUBS,U,3)
+5 SET DGBTDIVN=$PIECE(SUBS,U,4)
+6 SET TYPE=$PIECE(SUBS,U,5)
+7 SET REPTYPE=$PIECE(SUBS,U,6)
+8 SET CLERKALL=$PIECE(SUBS,U,7)
+9 SET CLERK=$PIECE(SUBS,U,8)
+10 SET CLERKNAME=$$GET1^DIQ(200,CLERK,.01)
+11 DO GETRECS
+12 IF '$DATA(^TMP("DGBTRPTC",$JOB))
WRITE !,"No records found"
DO QUIT
QUIT
+13 DO PRINT
+14 QUIT
GETRECS ;
+1 IF ((TYPE="M")&(REPTYPE="F"))
FOR I="CLAIMS","TOT MILE","CC FEE","ECON","M&L","F&B","DED","PAY"
SET GRAND(I)=0
+2 IF ((TYPE="M")&(REPTYPE="T"))
FOR I="MILE","CC FEE","ECON","M&L","F&B","DED","PAY"
SET GRAND(I)=0
+3 IF ((TYPE="S")&(REPTYPE="F"))
FOR I="CLAIMS","MILE","BASE RATE","NSNL","WAIT TIME","EXTRA CREW","SPECIAL EQUIPMENT","INVOICE AMT"
SET GRAND(I)=0
+4 IF ((TYPE="S")&(REPTYPE="T"))
FOR I="CLAIMS","MILE","BASE RATE","NSNL","WAIT TIME","EXTRA CREW","SPECIAL EQUIPMENT","INVOICE AMT"
SET GRAND(I)=0
+5 SET ENTRY=$ORDER(^DGBT(392,"D",STARTDT),-1)
+6 FOR
SET ENTRY=$ORDER(^DGBT(392,"D",ENTRY))
if ENTRY=""
QUIT
if ENTRY>ENDDT
QUIT
Begin DoDot:1
+7 SET I=""
+8 FOR
SET I=$ORDER(^DGBT(392,"D",ENTRY,I))
if I=""
QUIT
DO GETLINE
End DoDot:1
+9 QUIT
GETLINE ;
+1 SET LINEZERO=$GET(^DGBT(392,I,0))
if '$$CLERK
QUIT
+2 ;'="NO" Q
IF $$GET1^DIQ(392,I,45.2,"I")
QUIT
+3 IF '$$DIV
QUIT
+4 SET DATALINE=""
+5 SET SQ1=$PIECE(LINEZERO,"^",13)_"^"_$PIECE(LINEZERO,"^",12)
+6 IF TYPE="M"
DO GLMILE
+7 IF TYPE="S"
DO GLSP
+8 IF DATALINE'=""
SET ^TMP("DGBTRPTC",$JOB,SQ1,SQ2)=DATALINE
+9 QUIT
DIV() ;
+1 IF DGBTDIVN="ALL"
QUIT 1
+2 QUIT $PIECE(LINEZERO,U,11)=DGBTDIVN
CLERK() ;
+1 IF CLERKALL
QUIT 1
+2 QUIT $PIECE(LINEZERO,"^",12)=CLERK
GLMILE ;
+1 IF $$GET1^DIQ(392,I,56,"I")'="M"
QUIT
+2 SET LINEM=$GET(^DGBT(392,I,"M"))
+3 SET CCFEE=$$GET1^DIQ(392,$PIECE(LINEZERO,U),55)
+4 IF REPTYPE="F"
DO GLMILEF
+5 IF REPTYPE="T"
DO GLMILET
+6 QUIT
GLMILEF ; Mileage full
+1 SET SQ2=$ORDER(^TMP("DGBTRPTC",$JOB,SQ1,""),-1)+1
+2 SET DFN=$PIECE(LINEZERO,U,2)
if DFN=""
QUIT
+3 SET PATZERO=$GET(^DPT(DFN,0))
+4 ; Pat name
SET DATALINE=$PIECE(PATZERO,U)
+5 SET GRAND("CLAIMS")=GRAND("CLAIMS")+1
+6 ; Pat ID
SET $PIECE(DATALINE,U,2)=$PIECE(PATZERO,U,9)
+7 ; Claim date/time
SET $PIECE(DATALINE,U,3)=$$FMTE^XLFDT($PIECE($PIECE(LINEZERO,U),"."))
+8 IF DGBTEXC
SET $PIECE(DATALINE,U,3)=$PIECE($PIECE(DATALINE,U,3),"@")
+9 ; Division
SET $PIECE(DATALINE,U,4)=$$GET1^DIQ(40.8,$PIECE(LINEZERO,U,11),.01)
+10 ; Account
SET $PIECE(DATALINE,U,5)=$$GET1^DIQ(392.3,$PIECE(LINEZERO,U,6),2)
+11 SET $PIECE(DATALINE,U,6)=$SELECT($PIECE(LINEM,U)=1:"O",1:"R")
+12 ; Total mileage
SET $PIECE(DATALINE,U,7)=$PIECE(LINEM,U)*$PIECE(LINEM,U,2)
+13 SET GRAND("TOT MILE")=GRAND("TOT MILE")+($PIECE(LINEM,U)*$PIECE(LINEM,U,2))
+14 ; Common carrier mode
SET $PIECE(DATALINE,U,8)=$$GET1^DIQ(392,$PIECE(LINEZERO,U),44)
+15 ; Common carrier fee
SET $PIECE(DATALINE,U,9)=$$DLRAMT(CCFEE)
+16 SET GRAND("CC FEE")=GRAND("CC FEE")+$$GET1^DIQ(392,$PIECE(LINEZERO,U),55)
+17 ; Most economical cost
SET $PIECE(DATALINE,U,10)=$$DLRAMT($PIECE(LINEZERO,U,8))
+18 SET GRAND("ECON")=GRAND("ECON")+$PIECE(LINEZERO,U,8)
+19 ; Meals & lodging
SET $PIECE(DATALINE,U,11)=$$DLRAMT($PIECE(LINEM,U,4))
+20 SET GRAND("M&L")=GRAND("M&L")+$PIECE(LINEM,U,4)
+21 ; Ferries & bridges
SET $PIECE(DATALINE,U,12)=$$DLRAMT($PIECE(LINEM,U,5))
+22 SET GRAND("F&B")=GRAND("F&B")+$PIECE(LINEM,U,5)
+23 ; Deductible
SET $PIECE(DATALINE,U,13)=$$DLRAMT($PIECE(LINEZERO,U,9))
+24 SET GRAND("DED")=GRAND("DED")+$PIECE(LINEZERO,U,9)
+25 ; Payable
SET $PIECE(DATALINE,U,14)=$$DLRAMT($PIECE(LINEZERO,U,10))
+26 SET GRAND("PAY")=GRAND("PAY")+$PIECE(LINEZERO,U,10)
+27 ; Remarks
SET $PIECE(DATALINE,U,15)=$TRANSLATE($$GET1^DIQ(392,$PIECE(LINEZERO,U),51),"^","")
+28 QUIT
GLMILET ; Mileage total
+1 SET $PIECE(SQ1,"^",3)=$PIECE(LINEZERO,U,11)
+2 SET $PIECE(SQ1,"^",4)=$PIECE(LINEZERO,U,6)
+3 SET SQ2=0
+4 SET DATALINE=$GET(^TMP("DGBTRPTC",$JOB,SQ1,SQ2))
+5 ; MILEAGE
SET $PIECE(DATALINE,U)=($PIECE(LINEM,U)*$PIECE(LINEM,U,2))+$PIECE(DATALINE,U)
+6 ;COMMON CARRIER FEE
SET $PIECE(DATALINE,U,2)=$$GET1^DIQ(392,I,55)+$PIECE(DATALINE,U,2)
+7 SET GRAND("CC FEE")=GRAND("CC FEE")+CCFEE
+8 ; MOST ECONOMICAL COST
SET $PIECE(DATALINE,U,3)=$PIECE(LINEZERO,U,8)+$PIECE(DATALINE,U,3)
+9 SET GRAND("ECON")=GRAND("ECON")+$PIECE(LINEZERO,U,8)
+10 ; MEALS & LODGING
SET $PIECE(DATALINE,U,4)=$PIECE(LINEM,U,4)+$PIECE(DATALINE,U,4)
+11 SET GRAND("M&L")=GRAND("M&L")+$PIECE(LINEM,U,4)
+12 ; FERRIES & BRIDGES
SET $PIECE(DATALINE,U,5)=$PIECE(LINEM,U,5)+$PIECE(DATALINE,U,5)
+13 SET GRAND("F&B")=GRAND("F&B")+$PIECE(LINEM,U,5)
+14 ; DEDUCTIBLE
SET $PIECE(DATALINE,U,6)=$PIECE(LINEZERO,U,9)+$PIECE(DATALINE,U,6)
+15 SET GRAND("DED")=GRAND("DED")+$PIECE(LINEZERO,U,9)
+16 ; PAYABLE
SET $PIECE(DATALINE,U,7)=$PIECE(LINEZERO,U,10)+$PIECE(DATALINE,U,7)
+17 SET GRAND("PAY")=GRAND("PAY")+$PIECE(LINEZERO,U,10)
+18 QUIT
GLSP ;
+1 IF $$GET1^DIQ(392,I,56,"I")'="S"
QUIT
+2 SET LINESP=$GET(^DGBT(392,I,"SP"))
+3 IF REPTYPE="F"
DO GLSPF
+4 IF REPTYPE="T"
DO GLSPT
+5 QUIT
GLSPF ; Special mode full
+1 SET SQ2=$ORDER(^TMP("DGBTRPTC",$JOB,SQ1,""),-1)+1
+2 SET DFN=$PIECE(LINEZERO,U,2)
if DFN=""
QUIT
+3 SET PATZERO=$GET(^DPT(DFN,0))
+4 ; Pat name
SET DATALINE=$PIECE(PATZERO,U)
+5 SET GRAND("CLAIMS")=GRAND("CLAIMS")+1
+6 ; Pat ID
SET $PIECE(DATALINE,U,2)=$PIECE(PATZERO,U,9)
+7 ; Claim date/time
SET $PIECE(DATALINE,U,3)=$$FMTE^XLFDT($PIECE($PIECE(LINEZERO,U),"."))
+8 IF DGBTEXC
SET $PIECE(DATALINE,U,3)=$PIECE($PIECE(DATALINE,U,3),"@")
+9 ; Division
SET $PIECE(DATALINE,U,4)=$$GET1^DIQ(40.8,$PIECE(LINEZERO,U,11),.01)
+10 ; Account
SET $PIECE(DATALINE,U,5)=$$GET1^DIQ(392.3,$PIECE(LINEZERO,U,6),2)
+11 ; Mileage
SET $PIECE(DATALINE,U,6)=$PIECE(LINESP,U,12)
+12 SET GRAND("MILE")=GRAND("MILE")+$PIECE(LINESP,U,12)
+13 ; Base rate fee
SET $PIECE(DATALINE,U,7)=$$DLRAMT($PIECE(LINESP,U,5))
+14 SET GRAND("BASE RATE")=GRAND("BASE RATE")+$PIECE(LINESP,U,5)
+15 ; No show/no load fee
SET $PIECE(DATALINE,U,8)=$$DLRAMT($PIECE(LINESP,U,7))
+16 SET GRAND("NSNL")=GRAND("NSNL")+$PIECE(LINESP,U,7)
+17 ; Wait time fee
SET $PIECE(DATALINE,U,9)=$$DLRAMT($PIECE(LINESP,U,8))
+18 SET GRAND("WAIT TIME")=GRAND("WAIT TIME")+$PIECE(LINESP,U,8)
+19 ; Extra crew fee
SET $PIECE(DATALINE,U,10)=$$DLRAMT($PIECE(LINESP,U,9))
+20 SET GRAND("EXTRA CREW")=GRAND("EXTRA CREW")+$PIECE(LINESP,U,9)
+21 ; Special equipment fee
SET $PIECE(DATALINE,U,11)=$$DLRAMT($PIECE(LINESP,U,10))
+22 SET GRAND("SPECIAL EQUIPMENT")=GRAND("SPECIAL EQUIPMENT")+$PIECE(LINESP,U,10)
+23 ; Invoice
SET $PIECE(DATALINE,U,12)=$$DLRAMT($PIECE(LINESP,U,4))
+24 SET GRAND("INVOICE AMT")=GRAND("INVOICE AMT")+$PIECE(LINESP,U,4)
+25 ; Remarks
SET $PIECE(DATALINE,U,13)=$TRANSLATE($PIECE(LINESP,U,26),"^","")
+26 QUIT
GLSPT ; Special mode total
+1 SET $PIECE(SQ1,"^",3)=$PIECE(LINEZERO,U,11)
+2 SET $PIECE(SQ1,"^",4)=$PIECE(LINEZERO,U,6)
+3 SET SQ2=0
+4 SET DATALINE=$GET(^TMP("DGBTRPTC",$JOB,SQ1,SQ2))
+5 ; TOTAL CLAIMS
SET $PIECE(DATALINE,U)=1+$PIECE(DATALINE,U)
+6 SET GRAND("CLAIMS")=GRAND("CLAIMS")+1
+7 ; MILEAGE
SET $PIECE(DATALINE,U,2)=$PIECE(LINESP,U,12)+$PIECE(DATALINE,U,2)
+8 SET GRAND("MILE")=GRAND("MILE")+$PIECE(LINESP,U,12)
+9 ; BASE RATE FEE
SET $PIECE(DATALINE,U,3)=$PIECE(LINESP,U,5)+$PIECE(DATALINE,U,3)
+10 SET GRAND("BASE RATE")=GRAND("BASE RATE")+$PIECE(LINESP,U,5)
+11 ; NO LOAD/NO SHOW
SET $PIECE(DATALINE,U,4)=$PIECE(LINESP,U,7)+$PIECE(DATALINE,U,4)
+12 SET GRAND("NSNL")=GRAND("NSNL")+$PIECE(LINESP,U,7)
+13 ; WAIT TIME
SET $PIECE(DATALINE,U,5)=$PIECE(LINESP,U,8)+$PIECE(DATALINE,U,5)
+14 SET GRAND("WAIT TIME")=GRAND("WAIT TIME")+$PIECE(LINESP,U,8)
+15 ; EXTRA CREW
SET $PIECE(DATALINE,U,6)=$PIECE(LINESP,U,9)+$PIECE(DATALINE,U,6)
+16 SET GRAND("EXTRA CREW")=GRAND("EXTRA CREW")+$PIECE(LINESP,U,9)
+17 ; SPECIAL EQUIPMENT
SET $PIECE(DATALINE,U,7)=$PIECE(LINESP,U,10)+$PIECE(DATALINE,U,7)
+18 SET GRAND("SPECIAL EQUIPMENT")=GRAND("SPECIAL EQUIPMENT")+$PIECE(LINESP,U,10)
+19 ; TOTAL INVOICE AMOUNT
SET $PIECE(DATALINE,U,8)=$PIECE(LINESP,U,4)+$PIECE(DATALINE,U,8)
+20 SET GRAND("INVOICE AMT")=GRAND("INVOICE AMT")+$PIECE(LINESP,U,4)
+21 QUIT
PRINT ;
+1 USE IO
+2 SET PAGE=0
SET $PIECE(EQUAL,"=",133)=""
+3 DO NOW^%DTC
SET Y=%
DO DD^%DT
SET PDT=Y
+4 IF DGBTEXC
Begin DoDot:1
+5 IF (TYPE="M")&(REPTYPE="F")
Begin DoDot:2
+6 WRITE "DATE ENTERED^PATIENT^PATIENT ID^CLERK^CLAIM DATE^DIVISION^ACCT^R/O^MILEAGE^CC MODE^CC FEE^MOST ECONOMIC^M & L^FERRIES & BRIDGES^DEDUCTIBLE^AMOUNT PAYABLE^REMARK"
End DoDot:2
+7 IF (TYPE="M")&(REPTYPE="T")
Begin DoDot:2
+8 WRITE "DATE ENTERED^CLERK^DIVISION^ACCT^MILEAGE^CC FEE^MOST ECONOMIC^M & L^FERRIES &BRIDGES^DEDUCTIBLE^AMOUNT PAYABLE"
End DoDot:2
+9 IF (TYPE="S")&(REPTYPE="F")
Begin DoDot:2
+10 WRITE "DATE ENTERED^PATIENT^PATIENT ID^CLERK^CLAIM DATE^DIVISION^ACCT^MILEAGE^BASE RATE^NO SHOW NO LOAD^WAIT TIME^EXTRA CREW^SPECIAL EQUIPMENT^INVOICE AMOUNT^REMARK"
End DoDot:2
+11 IF (TYPE="S")&(REPTYPE="T")
Begin DoDot:2
+12 WRITE "DATE ENTERED^CLERK^DIVISION^ACCT^# CLAIMS^MILEAGE^BASE RATE^NO SHOW NO LOAD^WAIT TIME^EXTRA CREW^SPECIAL EQUIPMENT^INVOICE AMOUNT"
End DoDot:2
End DoDot:1
+13 IF (TYPE="M")&(REPTYPE="F")&('DGBTEXC)
DO HDRMF^DGBTR3A
+14 IF (TYPE="M")&(REPTYPE="T")&('DGBTEXC)
DO HDRMT
+15 IF (TYPE="S")&(REPTYPE="F")&('DGBTEXC)
DO HDRSF
+16 IF (TYPE="S")&(REPTYPE="T")&('DGBTEXC)
DO HDRST
+17 SET (PROMPT,SQ1)=""
+18 FOR
SET SQ1=$ORDER(^TMP("DGBTRPTC",$JOB,SQ1))
if SQ1=""
QUIT
Begin DoDot:1
+19 SET SQ2=""
+20 FOR
SET SQ2=$ORDER(^TMP("DGBTRPTC",$JOB,SQ1,SQ2))
if SQ2=""
QUIT
Begin DoDot:2
+21 SET DATALINE=^TMP("DGBTRPTC",$JOB,SQ1,SQ2)
+22 IF DGBTEXC
DO PRTXL
QUIT
+23 IF (TYPE="M")&(REPTYPE="F")&(($Y+4)>IOSL)
Begin DoDot:3
+24 DO HDRMF^DGBTR3A
End DoDot:3
if PROMPT="^"
QUIT
+25 IF (TYPE="M")&(REPTYPE="F")
Begin DoDot:3
+26 WRITE !,$PIECE(DATALINE,U),?32,$PIECE(DATALINE,U,2),?43,$$GET1^DIQ(200,$PIECE(SQ1,U,2),.01),?78,$PIECE(DATALINE,U,3),?92,$$FMTE^XLFDT($PIECE(SQ1,U))
+27 WRITE ?109,$PIECE(DATALINE,U,5)
+28 WRITE !,?5,$PIECE(DATALINE,U,4),?42,$PIECE(DATALINE,U,6),?48,$PIECE(DATALINE,U,7),?54,$PIECE(DATALINE,U,8),?92,$PIECE(DATALINE,U,9),?107,$PIECE(DATALINE,U,10)
+29 WRITE ?119,$PIECE(DATALINE,U,11)
+30 WRITE !,?5,$PIECE(DATALINE,U,12),?17,$PIECE(DATALINE,U,13),?25,$PIECE(DATALINE,U,14),?38,$PIECE(DATALINE,U,15)
End DoDot:3
+31 IF (TYPE="S")&(REPTYPE="F")&(($Y+4)>IOSL)
Begin DoDot:3
+32 DO HDRSF
End DoDot:3
if PROMPT="^"
QUIT
+33 IF (TYPE="S")&(REPTYPE="F")
Begin DoDot:3
+34 WRITE !,$PIECE(DATALINE,U),?32,$PIECE(DATALINE,U,2),?43,$$GET1^DIQ(200,$PIECE(SQ1,U,2),.01),?78,$PIECE(DATALINE,U,3),?92,$$FMTE^XLFDT($PIECE(SQ1,U))
+35 WRITE ?109,$PIECE(DATALINE,U,5)
+36 WRITE !,?5,$PIECE(DATALINE,U,4),?42,$PIECE(DATALINE,U,6),?50,$PIECE(DATALINE,U,7),?65,$PIECE(DATALINE,U,8),?79,$PIECE(DATALINE,U,9),?90,$PIECE(DATALINE,U,10)
+37 WRITE ?102,$PIECE(DATALINE,U,11),?116,$PIECE(DATALINE,U,12)
+38 WRITE !,?5,$PIECE(DATALINE,U,13)
End DoDot:3
+39 IF (TYPE="M")&(REPTYPE="T")&(($Y+3)>IOSL)
Begin DoDot:3
+40 DO HDRMT
End DoDot:3
if PROMPT="^"
QUIT
+41 IF (TYPE="M")&(REPTYPE="T")
Begin DoDot:3
+42 WRITE !,$$GET1^DIQ(40.8,$PIECE(SQ1,U,3),.01),?37,$$FMTE^XLFDT($PIECE(SQ1,U)),?50,$$GET1^DIQ(392.3,$PIECE(SQ1,U,4),2),?55,$PIECE(DATALINE,U)
+43 WRITE ?63,$$DLRAMT($PIECE(DATALINE,U,2)),?78,$$DLRAMT($PIECE(DATALINE,U,3)),?90,$$DLRAMT($PIECE(DATALINE,U,4)),?103,$$DLRAMT($PIECE(DATALINE,U,5))
+44 WRITE !,?5,$$DLRAMT($PIECE(DATALINE,U,6)),?18,$$DLRAMT($PIECE(DATALINE,U,7)),?29,$$GET1^DIQ(200,$PIECE(SQ1,U,2),.01)
End DoDot:3
+45 IF (TYPE="S")&(REPTYPE="T")&(($Y+3)>IOSL)
Begin DoDot:3
+46 DO HDRST
End DoDot:3
if PROMPT="^"
QUIT
+47 IF (TYPE="S")&(REPTYPE="T")
Begin DoDot:3
+48 WRITE !,$$GET1^DIQ(40.8,$PIECE(SQ1,U,3),.01),?37,$$FMTE^XLFDT($PIECE(SQ1,U)),?50,$$GET1^DIQ(392.3,$PIECE(SQ1,U,4),2),?55,$PIECE(DATALINE,U,2)
+49 WRITE ?63,$PIECE(DATALINE,U),?72,$$DLRAMT($PIECE(DATALINE,U,3)),?87,$$DLRAMT($PIECE(DATALINE,U,4)),?102,$$DLRAMT($PIECE(DATALINE,U,5))
+50 WRITE ?117,$$DLRAMT($PIECE(DATALINE,U,6))
+51 WRITE !,?5,$$DLRAMT($PIECE(DATALINE,U,7)),?15,$$DLRAMT($PIECE(DATALINE,U,8)),?25,$$GET1^DIQ(200,$PIECE(SQ1,U,2),.01)
End DoDot:3
+52 QUIT
End DoDot:2
if PROMPT="^"
QUIT
End DoDot:1
if PROMPT="^"
QUIT
+53 IF 'DGBTEXC
Begin DoDot:1
+54 IF ($Y+4)<IOSL
WRITE !!!
+55 IF (REPTYPE="F")
IF (TYPE="M")
DO GRANDMF^DGBTR3A
+56 IF (REPTYPE="T")
IF (TYPE="M")
DO GRANDMT^DGBTR3A
+57 IF (REPTYPE="F")
IF (TYPE="S")
DO GRANDSF^DGBTR3A
+58 IF (REPTYPE="T")
IF (TYPE="S")
DO GRANDST^DGBTR3A
End DoDot:1
+59 IF IOST["C-"
SET Y=$$PAUSE^DGBTUTL(DGBTEXC)
+60 IF IOST'["C-"
WRITE !,"REPORT HAS FINISHED"
+61 QUIT
PRTXL ;
+1 IF REPTYPE="F"
Begin DoDot:1
+2 WRITE !,$$FMTE^XLFDT($PIECE(SQ1,U)),U,$PIECE(DATALINE,U),U,$PIECE(DATALINE,U,2),U,$$GET1^DIQ(200,$PIECE(SQ1,U,2),.01)
FOR I=3:1:$LENGTH(DATALINE,U)
WRITE U,$PIECE(DATALINE,U,I)
End DoDot:1
+3 IF REPTYPE="T"
Begin DoDot:1
+4 WRITE !,$$FMTE^XLFDT($PIECE(SQ1,U)),U,$$GET1^DIQ(200,$PIECE(SQ1,U,2),.01),U,$$GET1^DIQ(40.8,$PIECE(SQ1,U,3),.01),U,$$GET1^DIQ(392.3,$PIECE(SQ1,U,4),2)
+5 IF TYPE="M"
Begin DoDot:2
+6 WRITE U,$PIECE(DATALINE,U,1)
+7 FOR I=2:1:$LENGTH(DATALINE,U)
WRITE U,$$DLRAMT($PIECE(DATALINE,U,I))
End DoDot:2
+8 IF TYPE="S"
Begin DoDot:2
+9 FOR I=1,2
WRITE U,$PIECE(DATALINE,U,I)
+10 FOR I=3:1:$LENGTH(DATALINE,U)
WRITE U,$$DLRAMT($PIECE(DATALINE,U,I))
End DoDot:2
End DoDot:1
+11 QUIT
DLRAMT(X) ;
+1 DO COMMA^%DTC
IF 'DGBTEXC
QUIT $TRANSLATE(X," ","")
+2 QUIT $TRANSLATE(X," ,$","")
HDRMT ;
+1 SET PAGE=PAGE+1
+2 WRITE @IOF
+3 WRITE "BT CLERK REPORT PRINT DATE: ",PDT,?(126-$LENGTH(PAGE)),"PAGE ",PAGE
+4 WRITE !,$$FMTE^XLFDT(STARTDT)," TO ",$$FMTE^XLFDT(ENDDT)
+5 WRITE !,"VERSION: TOTAL"
+6 WRITE !,"TYPE: MILEAGE"
+7 WRITE !,"DIVISION: ",$SELECT(DGBTDIVN="ALL":"ALL",1:$$GET1^DIQ(40.8,DGBTDIVN,.01))
+8 WRITE !,"CLERK: ",$SELECT(CLERKALL:"ALL",1:CLERKNAME)
+9 WRITE !,$EXTRACT(EQUAL,1,117)
+10 WRITE !,"DIVISION",?37,"ENTERED",?50,"ACCT",?55,"MILEAGE",?63,"CC FEE",?78,"MOST ECON",?90,"M&L",?103,"F&B"
+11 WRITE !,?5,"DED",?18,"PAYABLE",?29,"CLERK"
+12 WRITE !,$EXTRACT(EQUAL,1,117)
+13 QUIT
HDRSF ;
+1 SET PAGE=PAGE+1
+2 WRITE @IOF
+3 WRITE "BT CLERK REPORT PRINT DATE: ",PDT,?(126-$LENGTH(PAGE)),"PAGE ",PAGE
+4 WRITE !,$$FMTE^XLFDT(STARTDT)," TO ",$$FMTE^XLFDT(ENDDT)
+5 WRITE !,"VERSION: FULL"
+6 WRITE !,"TYPE: SPECIAL MODE"
+7 WRITE !,"DIVISION: ",$SELECT(DGBTDIVN="ALL":"ALL",1:$$GET1^DIQ(40.8,DGBTDIVN,.01))
+8 WRITE !,"CLERK: ",$SELECT(CLERKALL:"ALL",1:CLERKNAME)
+9 WRITE !,$EXTRACT(EQUAL,1,124)
+10 WRITE !,"PATIENT NAME",?32,"SSN",?43,"CLERK",?78,"CL DT",?92,"ENT DT",?109,"ACCT"
+11 WRITE !,?5,"DIVISION",?42,"MILEAGE",?50,"BASE RATE",?65,"NSNL",?79,"WAIT TIME",?90,"EX CREW",?102,"SPEC EQ",?116,"INV AMT"
+12 WRITE !,?5,"REMARKS"
+13 WRITE !,$EXTRACT(EQUAL,1,124)
+14 QUIT
HDRST ;
+1 SET PAGE=PAGE+1
+2 WRITE @IOF
+3 WRITE "BT CLERK REPORT PRINT DATE: ",PDT,?(126-$LENGTH(PAGE)),"PAGE ",PAGE
+4 WRITE !,$$FMTE^XLFDT(STARTDT)," TO ",$$FMTE^XLFDT(ENDDT)
+5 WRITE !,"VERSION: TOTAL"
+6 WRITE !,"TYPE: SPECIAL MODE"
+7 WRITE !,"DIVISION: ",$SELECT(DGBTDIVN="ALL":"ALL",1:$$GET1^DIQ(40.8,DGBTDIVN,.01))
+8 WRITE !,"CLERK: ",$SELECT(CLERKALL:"ALL",1:CLERKNAME)
+9 WRITE !,$EXTRACT(EQUAL,1,127)
+10 WRITE !,"DIVISION",?37,"ENTERED",?50,"ACCT",?55,"MILEAGE",?63,"CLAIMS",?72,"BASE RATE",?87,"NSNL",?102,"WAIT TIME",?117,"EXTRA CREW"
+11 WRITE !,?5,"SPEC EQ",?15,"INV AMT",?25,"CLERK"
+12 WRITE !,$EXTRACT(EQUAL,1,127)
+13 QUIT
QUIT ;
+1 KILL ^TMP("DGBTRPTC",$JOB)
+2 DO CLEAN^DILF
+3 QUIT
