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

DGBTR125.m

Go to the documentation of this file. 
  1. DGBTR125 ;ALB/RFE - SPECIAL MODE REPORT; 06/22/12
  1.  ;;1.0;Beneficiary Travel;**20**;November 11, 2011;Build 185
  1.  Q
  1. EN ;Entry point
  1.  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
  1.  N STARTDT,X,X2,X3,Y,ZTQUEUED
  1.  D CLEAN^DILF
  1.  S X2="2$"
  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.  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" 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
  1.  .S DGBTDIVN=$O(^DG(40.8,0))
  1.  I (($D(DIRUT))!($D(DTOUT))!($D(DUOUT))) D CLEAN^DILF Q
  1.  F  D  Q:DONE
  1.  .S DONE=1
  1.  .K DIR S DIR("A")="START NAME",DIR("B")="AAA",DIR(0)="F^1:30^" D ^DIR K DIR
  1.  .I ($D(DIRUT))!($D(DIROUT)) Q
  1.  .S SNAME=$$UP^XLFSTR(Y)
  1.  .K DIR S DIR("A")="END NAME",DIR("B")="ZZZ",DIR(0)="F^1:30^" D ^DIR K DIR
  1.  .I ($D(DIRUT))!($D(DIROUT)) Q
  1.  .S ENAME=$$UP^XLFSTR(Y)
  1.  .I SNAME]ENAME W !,"START NAME CANNOT FOLLOW END NAME" S DONE=0 Q
  1.  K DONE
  1.  I ($D(DIRUT))!($D(DIROUT)) D CLEAN^DILF Q
  1.  K DIR
  1.  S DIR(0)="S^F:FULL;T:TOTAL",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 REPTYPE=Y
  1.  D SETPRT,QUIT
  1.  Q
  1. SETPRT ;
  1.  S DGBTEXC=$$SELEXCEL^DGBTUTL
  1.  I DGBTEXC="^" Q
  1.  I 'DGBTEXC N COLWID S COLWID=132 D PRINTMSG^DGBTUTL
  1.  D DEVICE^DGBTUTL("Beneficiary Travel Special Mode Report","MAIN^DGBTR125(DGBTEXC,STARTDT,ENDDT,DGBTDIVN,SNAME,ENAME,REPTYPE)",DGBTEXC,132)
  1.  I $G(DGBTQ) Q
  1.  ;
  1.  I $D(IO("Q")) D:'$D(ZTQUEUED) ^%ZISC Q
  1.  D MAIN(DGBTEXC,STARTDT,ENDDT,DGBTDIVN,SNAME,ENAME,REPTYPE)
  1.  D:'$D(ZTQUEUED) ^%ZISC
  1.  U IO
  1.  Q
  1. MAIN(DGBTEXC,STARTDT,ENDDT,DGBTDIVN,SNAME,ENAME,REPTYPE) ;
  1.  K ^TMP("DGBTR125",$J)
  1.  D GETRECS
  1.  I '$D(^TMP("DGBTR125",$J)) W !,"No records found" D QUIT Q
  1.  D PRINT
  1.  Q
  1. GETRECS ;
  1.  I REPTYPE="F" F I="CLAIMS","MILE","BASE RATE","MILEAGE FEE","NSNL","WAIT TIME","EXTRA CREW","SPECIAL EQUIPMENT","INVOICE AMT" S GRAND(I)=0
  1.  I REPTYPE="T" F I="PAID","DENIED","CLAIMS","NSNL","PAID AMT" 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 '$$DIV Q
  1.  S DATALINE=""
  1.  I $$GET1^DIQ(392,I,56,"I")'="S" Q
  1.  S DFN=$P(LINEZERO,U,2) Q:DFN=""
  1.  S PATNAME=$$GET1^DIQ(2,DFN,.01)
  1.  I '$$NMRNG^DGBTUTL(PATNAME,SNAME,ENAME,1) Q
  1.  S LINESP=$G(^DGBT(392,I,"SP"))
  1.  S DATALINE=""
  1.  I REPTYPE="F" D GLFULL
  1.  I REPTYPE="T" D GLTOTAL
  1.  I DATALINE'="" S ^TMP("DGBTR125",$J,SQ1,SQ2)=DATALINE
  1.  Q
  1. DIV() ;
  1.  I DGBTDIVN="ALL" Q 1
  1.  Q $P(LINEZERO,U,11)=DGBTDIVN
  1. GLFULL ; Special mode full
  1.  S SQ1=ENTRY
  1.  S SQ2=$O(^TMP("DGBTR125",$J,SQ1,""),-1)+1
  1.  S GRAND("CLAIMS")=GRAND("CLAIMS")+1
  1.  S $P(DATALINE,U)=PATNAME
  1.  S $P(DATALINE,U,2)=$$FMTE^XLFDT($P($P(LINEZERO,U),".")) ; Claim date/time
  1.  S $P(DATALINE,U,3)=$$GET1^DIQ(392.42,$P(LINESP,U),.01) ; Mode of transportation
  1.  S $P(DATALINE,U,4)=$P(LINESP,U,2) ; Invoice #
  1.  S $P(DATALINE,U,5)=$$FMTE^XLFDT($P(LINESP,U,3)) ; Invoice date
  1.  S $P(DATALINE,U,6)=$$GET1^DIQ(392,I,67,"I") ; One way/round trip
  1.  S $P(DATALINE,U,7)=$P(LINESP,U,12) ; Miles
  1.  S GRAND("MILE")=GRAND("MILE")+$P(LINESP,U,12)
  1.  S $P(DATALINE,U,8)=$$DLRAMT($P(LINESP,U,5)) ; Base rate fee
  1.  S GRAND("BASE RATE")=GRAND("BASE RATE")+$P(LINESP,U,5)
  1.  S $P(DATALINE,U,9)=$$DLRAMT($P(LINESP,U,6)) ; Mileage fee
  1.  S GRAND("MILEAGE FEE")=GRAND("MILEAGE FEE")+$P(LINESP,U,6)
  1.  S $P(DATALINE,U,10)=$$DLRAMT($P(LINESP,U,7)) ; No show/no load fee
  1.  S GRAND("NSNL")=GRAND("NSNL")+$P(LINESP,U,7)
  1.  S $P(DATALINE,U,11)=$$DLRAMT($P(LINESP,U,8)) ; Wait time fee
  1.  S GRAND("WAIT TIME")=GRAND("WAIT TIME")+$P(LINESP,U,8)
  1.  S $P(DATALINE,U,12)=$$DLRAMT($P(LINESP,U,9)) ; Extra crew fee
  1.  S GRAND("EXTRA CREW")=GRAND("EXTRA CREW")+$P(LINESP,U,9)
  1.  S $P(DATALINE,U,13)=$$DLRAMT($P(LINESP,U,10)) ; Special equipment fee
  1.  S GRAND("SPECIAL EQUIPMENT")=GRAND("SPECIAL EQUIPMENT")+$P(LINESP,U,10)
  1.  S $P(DATALINE,U,14)=$$DLRAMT($P(LINESP,U,4)) ; Total invoice amount
  1.  S GRAND("INVOICE AMT")=GRAND("INVOICE AMT")+$P(LINESP,U,4)
  1.  S $P(DATALINE,U,15)=$$GET1^DIQ(40.8,$P(LINEZERO,U,11),.01) ; Division
  1.  S $P(DATALINE,U,16)=$$GET1^DIQ(440,$P(LINESP,U,14),.01) ; Vendor
  1.  S $P(DATALINE,U,17)=$S($$GET1^DIQ(392,I,45.2,"I"):"D",1:"")
  1.  Q
  1. GLTOTAL ; Special mode total
  1.  S SQ1=$P(LINEZERO,U,11)_"^"_$$GET1^DIQ(392.42,$P(LINESP,U),.01)
  1.  S SQ2=0
  1.  S DENY=$$GET1^DIQ(392,I,45.2,"I")
  1.  S DATALINE=$G(^TMP("DGBTR125",$J,SQ1,SQ2))
  1.  S $P(DATALINE,U)=$P(DATALINE,U)+$S(DENY:0,1:1) ;claims paid
  1.  I 'DENY S GRAND("PAID")=GRAND("PAID")+1
  1.  S $P(DATALINE,U,2)=$P(DATALINE,U,2)+$S(DENY:1,1:0) ; Claims denied
  1.  I DENY S GRAND("DENIED")=GRAND("DENIED")+1
  1.  S $P(DATALINE,U,3)=1+$P(DATALINE,U,3) ; Number of claims
  1.  S GRAND("CLAIMS")=GRAND("CLAIMS")+1
  1.  S $P(DATALINE,U,4)=$P(DATALINE,U,4)+$S('DENY:$P(LINESP,U,7),1:0) ; No show/no load
  1.  I 'DENY S GRAND("NSNL")=GRAND("NSNL")+$P(LINESP,U,7)
  1.  S $P(DATALINE,U,5)=$P(DATALINE,U,5)+$S('DENY:$P(LINESP,U,4),1:0) ; Invoice
  1.  I 'DENY S GRAND("PAID AMT")=GRAND("PAID AMT")+$P(LINESP,U,4)
  1.  Q
  1. PRINT ;
  1.  U IO
  1.  S $P(EQUAL,"=",133)="",PAGE=0
  1.  D NOW^%DTC S Y=% D DD^%DT S PDT=Y
  1.  I 'DGBTEXC D
  1.  .I REPTYPE="F" D HDRFUL
  1.  .I REPTYPE="T" D HDRTOT
  1.  I DGBTEXC D
  1.  .I REPTYPE="F" D
  1.  ..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^"
  1.  ..W "DIVISION^VENDOR^STATUS"
  1.  .I REPTYPE="T" D
  1.  ..W "DIVISION^# PAID^# DENIED ^BY MODE^NSNL^INVOICE PAID^MODE"
  1.  S (PROMPT,SQ1)=""
  1.  F  S SQ1=$O(^TMP("DGBTR125",$J,SQ1)) Q:SQ1=""  D  Q:PROMPT="^"
  1.  .S SQ2=""
  1.  .F  S SQ2=$O(^TMP("DGBTR125",$J,SQ1,SQ2)) Q:SQ2=""  D  Q:PROMPT="^"
  1.  ..S DATALINE=^TMP("DGBTR125",$J,SQ1,SQ2)
  1.  ..I DGBTEXC D PRTXL Q
  1.  ..I ($Y+$S(REPTYPE="F":4,1:2))>IOSL D  Q:PROMPT="^"
  1.  ...I ($E(IOST,1)="C"),(IOSL'[99) R !,"Please press ENTER to continue or '^' to stop ",PROMPT:DTIME Q:PROMPT="^"
  1.  ...I REPTYPE="F" D HDRFUL
  1.  ...I REPTYPE="T" D HDRTOT
  1.  ..I REPTYPE="F" D PRTFUL
  1.  ..I REPTYPE="T" D PRTTOT
  1.  I 'DGBTEXC D
  1.  .I ($Y+4)<IOSL W !!!
  1.  .I REPTYPE="F" D GRANDFUL
  1.  .I REPTYPE="T" D GRANDTOT
  1.  I IOST["C-" S Y=$$PAUSE^DGBTUTL(DGBTEXC)
  1.  I IOST'["C-" W !,"REPORT HAS FINISHED"
  1.  Q
  1. PRTXL ;
  1.  I REPTYPE="F" D
  1.  . W !,$$FMTE^XLFDT($P(SQ1,U)),U,DATALINE
  1.  I REPTYPE="T" D
  1.  .W !,$$GET1^DIQ(40.8,$P(SQ1,U),.01),U F I=1:1:3 W $P(DATALINE,U,I),U
  1.  .W $$DLRAMT($P(DATALINE,U,4)),U,$$DLRAMT($P(DATALINE,U,5)),U,$P(SQ1,U,2)
  1.  Q
  1. PRTFUL ;
  1.  W !,$P(DATALINE,U),?32,$P(DATALINE,U,2),?52,$P(DATALINE,U,3),?84,$P(DATALINE,U,4),?116,$P(DATALINE,U,5)
  1.  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)
  1.  W ?73,$P(DATALINE,U,12),?83,$P(DATALINE,U,13),?94,$P(DATALINE,U,14),?105,$$FMTE^XLFDT(SQ1)
  1.  W !,?5,$P(DATALINE,U,15),?37,$P(DATALINE,U,16),?75,$P(DATALINE,U,17)
  1.  Q
  1. PRTTOT ;
  1.  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))
  1.  W ?74,$$DLRAMT($P(DATALINE,U,5)),?90,$P(SQ1,U,2)
  1.  Q
  1. HDRFUL ;
  1.  S PAGE=PAGE+1
  1.  W @IOF
  1.  W "BT SPECIAL MODE FULL REPORT      PRINT DATE: ",PDT,?(126-$L(PAGE)),"PAGE ",PAGE
  1.  W !,$$FMTE^XLFDT(STARTDT)," TO ",$$FMTE^XLFDT(ENDDT)
  1.  W !,"FIRST VETERAN NAME: ",SNAME
  1.  W !,"LAST VETERAN NAME: ",ENAME
  1.  W !,"DIVISION: ",$S(DGBTDIVN="ALL":"ALL",1:$$GET1^DIQ(40.8,DGBTDIVN,.01))
  1.  W !,$E(EQUAL,1,128)
  1.  W !,"PATIENT NAME",?32,"CLAIM DATE",?52,"MODE",?84,"INV #",?116,"INVOICE DATE"
  1.  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"
  1.  W !?5,"DIVISION",?37,"VENDOR",?75,"STATUS"
  1.  W !,$E(EQUAL,1,128)
  1.  Q
  1. HDRTOT ;
  1.  S PAGE=PAGE+1
  1.  W @IOF
  1.  W "BT SPECIAL MODE TOTAL REPORT      PRINT DATE: ",PDT,?(126-$L(PAGE)),"PAGE ",PAGE
  1.  W !,$$FMTE^XLFDT(STARTDT)," TO ",$$FMTE^XLFDT(ENDDT)
  1.  W !,"FIRST VETERAN NAME: ",SNAME
  1.  W !,"LAST VETERAN NAME: ",ENAME
  1.  W !,"DIVISION: ",$S(DGBTDIVN="ALL":"ALL",1:$$GET1^DIQ(40.8,DGBTDIVN,.01))
  1.  W !,$E(EQUAL,1,126)
  1.  W !,"DIVISION",?37,"PAID",?43,"DENIED",?51,"CLAIMS",?59,"NSNL",?74,"INV PAID",?90,"MODE"
  1.  W !,$E(EQUAL,1,126)
  1.  Q
  1. GRANDFUL ;
  1.  I ($Y+5)>IOSL D
  1.  .S PAGE=PAGE+1
  1.  .W @IOF
  1.  .W "BT SPECIAL MODE FULL REPORT      PRINT DATE: ",PDT,?(126-$L(PAGE)),"PAGE ",PAGE
  1.  .W !,$$FMTE^XLFDT(STARTDT)," TO ",$$FMTE^XLFDT(ENDDT)
  1.  .W !,"FIRST VETERAN NAME: ",SNAME
  1.  .W !,"LAST VETERAN NAME: ",ENAME
  1.  .W !,"DIVISION: ",$S(DGBTDIVN="ALL":"ALL",1:$$GET1^DIQ(40.8,DGBTDIVN,.01))
  1.  W !,$E(EQUAL,1,128)
  1.  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"
  1.  W !,?17,GRAND("MILE"),?27,$$DLRAMT(GRAND("BASE RATE")),?42,$$DLRAMT(GRAND("MILEAGE FEE")),?52,$$DLRAMT(GRAND("NSNL"))
  1.  W ?63,$$DLRAMT(GRAND("WAIT TIME")),?73,$$DLRAMT(GRAND("EXTRA CREW")),?83,$$DLRAMT(GRAND("SPECIAL EQUIPMENT"))
  1.  W ?94,$$DLRAMT(GRAND("INVOICE AMT")),?105,GRAND("CLAIMS")
  1.  W !,$E(EQUAL,1,128)
  1.  Q
  1. GRANDTOT ;
  1.  I ($Y+5)>IOSL D
  1.  .S PAGE=PAGE+1
  1.  .W @IOF
  1.  .W "BT SPECIAL MODE TOTAL REPORT      PRINT DATE: ",PDT,?(126-$L(PAGE)),"PAGE ",PAGE
  1.  .W !,$$FMTE^XLFDT(STARTDT)," TO ",$$FMTE^XLFDT(ENDDT)
  1.  .W !,"FIRST VETERAN NAME: ",SNAME
  1.  .W !,"LAST VETERAN NAME: ",ENAME
  1.  .W !,"DIVISION: ",$S(DGBTDIVN="ALL":"ALL",1:$$GET1^DIQ(40.8,DGBTDIVN,.01))
  1.  W !,$E(EQUAL,1,126)
  1.  W !,"GRAND TOTALS:",?37,"PAID",?43,"DENIED",?51,"CLAIMS",?59,"NSNL",?74,"INV PAID"
  1.  W !,?37,GRAND("PAID"),?43,GRAND("DENIED"),?51,GRAND("CLAIMS"),?59,$$DLRAMT(GRAND("NSNL")),?74,$$DLRAMT(GRAND("PAID AMT"))
  1.  W !,$E(EQUAL,1,126)
  1.  Q
  1. DLRAMT(X) ;
  1.  D COMMA^%DTC I 'DGBTEXC Q $TR(X," ","")
  1.  Q $TR(X," ,$","")
  1. QUIT ;
  1.  K ^TMP("DGBTR125",$J)
  1.  D CLEAN^DILF
  1.  Q