Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: DGBTR121

DGBTR121.m

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