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

IBJDB12.m

Go to the documentation of this file. 
  1. IBJDB12 ;ALB/CPM - BILLING LAG TIME REPORT (OPT PRINT/SUMMARIES) ; 30-DEC-96
  1.  ;;2.0;INTEGRATED BILLING;**69,100,118,524**;21-MAR-94;Build 24
  1.  ;;Per VHA Directive 6402, this routine should not be modified.
  1.  ;
  1. OPT ; - Print the outpatient report.
  1.  F IBX=1,"2I",9,10,"3I","4I",11,2,3,4 I IBSEL[(","_IBX_",") D  Q:IBQ
  1.  .I '$D(^TMP("IBJDB1",$J,IBDIV,"OP",IBX)) D  Q
  1.  ..S IBPAG=0 D OPTH I IBQ Q
  1.  ..W !!,"There was no ",$$TITLE^IBJDB1(+IBX,0)
  1.  ..I IBX["I" W " (Late Insurance)"
  1.  ..W !," claim activity during this period." D PAUSE
  1.  .;
  1.  .S IBPAG=0 D OPTH I IBQ Q
  1.  .K IBCT,IBTL S (IBCT(IBX),IBTL(IBX))=0,IBX1=""
  1.  .F  S IBX1=$O(^TMP("IBJDB1",$J,IBDIV,"OP",IBX,IBX1)) Q:IBX1=""  D  Q:IBQ
  1.  ..I $Y>(IOSL-2) D PAUSE Q:IBQ  D OPTH Q:IBQ
  1.  ..N IBWPT S IBWPT=1
  1.  ..S (IBH,IBX2)=0
  1.  ..F  S IBX2=$O(^TMP("IBJDB1",$J,IBDIV,"OP",IBX,IBX1,IBX2)) Q:'IBX2  S IBX3=$G(^(IBX2)) D  Q:IBQ
  1.  ...I $Y>(IOSL-4) D PAUSE Q:IBQ  D OPTH S IBWPT=1 Q:IBQ  S IBH=0
  1.  ...;
  1.  ...; - Write bill #, dates and total days.
  1.  ...W:IBH ! I 'IBH S IBH=1
  1.  ...I IBWPT D WPAT S IBWPT=0
  1.  ...W ?40,$P(IBX3,U),?50,$$DTE($P(IBX3,U,2)),$P(IBX3,U,5)
  1.  ...W ?63,$$DTE($P(IBX3,U,3)),?76,$J($P(IBX3,U,4),4)
  1.  ...S IBCT(IBX)=IBCT(IBX)+1,IBTL(IBX)=IBTL(IBX)+$P(IBX3,U,4)
  1.  .;
  1.  .D AVG,PAUSE
  1.  ;
  1. OPTQ Q
  1.  ;
  1. OPTH ; - Write the outpatient detail report header.
  1.  W @IOF,*13 S IBPAG=$G(IBPAG)+1
  1.  W !,"Outpatient Billing Lag Time Report"
  1.  W ?48,IBRUN,?72,"Page ",$J(IBPAG,3)
  1.  W !,$$TITLE^IBJDB1(+IBX,0) I IBX["I" W " (Late Insurance)"
  1.  W !,"Claims w/activity from ",$$DTE(IBBDT)," to ",$$DTE(IBEDT)
  1.  W " (*=Insurance found after trmt)"
  1.  W:IBDIV !,"Division: ",$P($G(^DG(40.8,IBDIV,0)),U) W !!
  1.  W:IBX[2!(IBX=11) ?50,"Date of" W:IBX=9!(IBX=10) ?50,"Date Claim"
  1.  W:IBX=1!(IBX[3)!(IBX=10) ?63,"Date of" W:IBX[2!(IBX=9) ?63,"Date Claim"
  1.  W ?76,"# of",!,"Patient",?27,"SSN",?40,"Bill #"
  1.  W:IBX=1!(IBX[3)!(IBX[4) ?50,"Date of Care"
  1.  W:IBX[2 ?50,"Check Out" W:IBX=9 ?50,"Authorized"
  1.  W:IBX=10 ?51,"Activated" W:IBX=11 ?50,"First Paymt"
  1.  W:IBX=1 ?63,"Check Out" W:IBX[3!(IBX=10) ?63,"First Paymt"
  1.  W:IBX[4!(IBX=11) ?63,"Date Closed" W:IBX[2 ?63,"Authorized"
  1.  W:IBX=9 ?64,"Activated" W ?76,"Days",!,$$DASH(80)
  1.  S IBQ=$$STOP^IBOUTL("Billing Lag Time Report")
  1.  Q
  1.  ;
  1. AVG ; - Write total days and average line.
  1.  W !?75,"-----",!,"Average Number of Days for",?75,$J(IBTL(IBX),5)
  1.  W !,$$TITLE^IBJDB1(+IBX,0),$S(IBX["I":" (Late Ins)",1:""),": "
  1.  W $J($S('IBCT(IBX):0,1:IBTL(IBX)/IBCT(IBX)),0,2)
  1.  W " (",IBCT(IBX)," claim",$S(IBCT(IBX)>1:"s",1:""),")"
  1.  Q
  1.  ;
  1. WPAT ; - Write patient data.
  1.  W !,$E($P(IBX1,"@@"),1,25),?27,$$SSN($P(IBX1,"@@",2))
  1.  Q
  1.  ;
  1. SUM ; - Print the summary reports.
  1.  D OPTS,PAUSE I IBQ G SUMQ
  1.  D INPS,PAUSE
  1. SUMQ Q
  1.  ;
  1. OPTS ; - Print the outpatient summary report.
  1.  I $E(IOST,1,2)="C-" W @IOF,*13
  1.  W !?32,"BILLING LAG TIME"
  1.  D CTR("OUTPATIENT SUMMARY REPORT"_$S(IBDIV:" for "_$P($G(^DG(40.8,IBDIV,0)),U),1:""))
  1.  D CTR("Receivables with activity from "_$$DTE(IBBDT)_" to "_$$DTE(IBEDT))
  1.  D CTR("Run Date: "_IBRUN) W !?12,$$DASH(55)
  1.  W !!?2,"Time Period",?50,"Average Number of days"
  1.  W !?2,"-----------",?50,"----------------------"
  1.  W !?2,$$TITLE^IBJDB1(1,0),?55,$J($S('IBCT(IBDIV,"OP",1):0,1:IBTL(IBDIV,"OP",1)/IBCT(IBDIV,"OP",1)),7,2)," (",IBCT(IBDIV,"OP",1)," claims)"
  1.  W !?2,$$TITLE^IBJDB1(2,0),"-LI",?55,$J($S('IBCT(IBDIV,"OP","2I"):0,1:IBTL(IBDIV,"OP","2I")/IBCT(IBDIV,"OP","2I")),7,2)," (",IBCT(IBDIV,"OP","2I")," claims)"
  1.  W !?2,$$TITLE^IBJDB1(9,0),?55,$J($S('IBCT(IBDIV,"OP",9):0,1:IBTL(IBDIV,"OP",9)/IBCT(IBDIV,"OP",9)),7,2)," (",IBCT(IBDIV,"OP",9)," claims)"
  1.  W !?2,$$TITLE^IBJDB1(10,0),?55,$J($S('IBCT(IBDIV,"OP",10):0,1:IBTL(IBDIV,"OP",10)/IBCT(IBDIV,"OP",10)),7,2)," (",IBCT(IBDIV,"OP",10)," claims)"
  1.  W !?2,$$TITLE^IBJDB1(3,0),"-LI",?55,$J($S('IBCT(IBDIV,"OP","3I"):0,1:IBTL(IBDIV,"OP","3I")/IBCT(IBDIV,"OP","3I")),7,2)," (",IBCT(IBDIV,"OP","3I")," claims)"
  1.  W !?2,$$TITLE^IBJDB1(4,0),"-LI",?55,$J($S('IBCT(IBDIV,"OP","4I"):0,1:IBTL(IBDIV,"OP","4I")/IBCT(IBDIV,"OP","4I")),7,2)," (",IBCT(IBDIV,"OP","4I")," claims)"
  1.  W !?2,$$TITLE^IBJDB1(11,0),?55,$J($S('IBCT(IBDIV,"OP",11):0,1:IBTL(IBDIV,"OP",11)/IBCT(IBDIV,"OP",11)),7,2)," (",IBCT(IBDIV,"OP",11)," claims)"
  1.  W !!?2,$$TITLE^IBJDB1(2,0),"+",?55,$J($S('IBCT(IBDIV,"OP",2):0,1:IBTL(IBDIV,"OP",2)/IBCT(IBDIV,"OP",2)),7,2)," (",IBCT(IBDIV,"OP",2)," claims)"
  1.  W !?2,$$TITLE^IBJDB1(3,0),"+",?55,$J($S('IBCT(IBDIV,"OP",3):0,1:IBTL(IBDIV,"OP",3)/IBCT(IBDIV,"OP",3)),7,2)," (",IBCT(IBDIV,"OP",3)," claims)"
  1.  W !?2,$$TITLE^IBJDB1(4,0),"+",?55,$J($S('IBCT(IBDIV,"OP",4):0,1:IBTL(IBDIV,"OP",4)/IBCT(IBDIV,"OP",4)),7,2)," (",IBCT(IBDIV,"OP",4)," claims)"
  1.  I $E(IOST,1,2)="C-" D
  1.  .W !!?2,"*LI=Late Insurance (policy identified after treatment)"
  1.  .W !?2,"+This element does not include Late Insurance claims"
  1.  E  W !!
  1.  Q
  1.  ;
  1. INPS ; - Print the inpatient summary report.
  1.  I $E(IOST,1,2)="C-" W @IOF,*13
  1.  W !?32,"BILLING LAG TIME"
  1.  D CTR("INPATIENT SUMMARY REPORT"_$S(IBDIV:" for "_$P($G(^DG(40.8,IBDIV,0)),U),1:""))
  1.  D CTR("Receivables with activity from "_$$DTE(IBBDT)_" to "_$$DTE(IBEDT))
  1.  I $E(IOST,1,2)="C-" D CTR("Run Date: "_IBRUN)
  1.  W !?12,$$DASH(55)
  1.  W !!?2,"Time Period",?50,"Average Number of days"
  1.  W !?2,"-----------",?50,"----------------------"
  1.  W !?2,$$TITLE^IBJDB1(5,0),?55,$J($S('IBCT(IBDIV,"IN",5):0,1:IBTL(IBDIV,"IN",5)/IBCT(IBDIV,"IN",5)),7,2)," (",IBCT(IBDIV,"IN",5)," claims)"
  1.  W !?2,$$TITLE^IBJDB1(6,0),"-LI",?55,$J($S('IBCT(IBDIV,"IN","6I"):0,1:IBTL(IBDIV,"IN","6I")/IBCT(IBDIV,"IN","6I")),7,2)," (",IBCT(IBDIV,"IN","6I")," claims)"
  1.  W !?2,$$TITLE^IBJDB1(9,0),?55,$J($S('IBCT(IBDIV,"IN",9):0,1:IBTL(IBDIV,"IN",9)/IBCT(IBDIV,"IN",9)),7,2)," (",IBCT(IBDIV,"IN",9)," claims)"
  1.  W !?2,$$TITLE^IBJDB1(10,0),?55,$J($S('IBCT(IBDIV,"IN",10):0,1:IBTL(IBDIV,"IN",10)/IBCT(IBDIV,"IN",10)),7,2)," (",IBCT(IBDIV,"IN",10)," claims)"
  1.  W !?2,$$TITLE^IBJDB1(7,0),"-LI",?55,$J($S('IBCT(IBDIV,"IN","7I"):0,1:IBTL(IBDIV,"IN","7I")/IBCT(IBDIV,"IN","7I")),7,2)," (",IBCT(IBDIV,"IN","7I")," claims)"
  1.  W !?2,$$TITLE^IBJDB1(8,0),"-LI",?55,$J($S('IBCT(IBDIV,"IN","8I"):0,1:IBTL(IBDIV,"IN","8I")/IBCT(IBDIV,"IN","8I")),7,2)," (",IBCT(IBDIV,"IN","8I")," claims)"
  1.  W !?2,$$TITLE^IBJDB1(11,0),?55,$J($S('IBCT(IBDIV,"IN",11):0,1:IBTL(IBDIV,"IN",11)/IBCT(IBDIV,"IN",11)),7,2)," (",IBCT(IBDIV,"IN",11)," claims)"
  1.  W !!?2,$$TITLE^IBJDB1(6,0),"+",?55,$J($S('IBCT(IBDIV,"IN",6):0,1:IBTL(IBDIV,"IN",6)/IBCT(IBDIV,"IN",6)),7,2)," (",IBCT(IBDIV,"IN",6)," claims)"
  1.  W !?2,$$TITLE^IBJDB1(7,0),"+",?55,$J($S('IBCT(IBDIV,"IN",7):0,1:IBTL(IBDIV,"IN",7)/IBCT(IBDIV,"IN",7)),7,2)," (",IBCT(IBDIV,"IN",7)," claims)"
  1.  W !?2,$$TITLE^IBJDB1(8,0),"+",?55,$J($S('IBCT(IBDIV,"IN",8):0,1:IBTL(IBDIV,"IN",8)/IBCT(IBDIV,"IN",8)),7,2)," (",IBCT(IBDIV,"IN",8)," claims)"
  1.  W !!?2,"*LI=Late Insurance (policy identified after treatment)"
  1.  W !?2,"+This element does not include Late Insurance claims"
  1.  Q
  1.  ;
  1. CTR(X) ; - Center and write text.
  1.  W !?(80-$L(X))\2,X
  1.  Q
  1.  ;
  1. DASH(X) ; - Return a dashed line.
  1.  Q $TR($J("",X)," ","=")
  1.  ;
  1. PAUSE ; - Page break.
  1.  I $E(IOST,1,2)'="C-" Q
  1.  N IBX,DIR,DIRUT,DUOUT,DTOUT,DIROUT,X,Y
  1.  F IBX=$Y:1:(IOSL-3) W !
  1.  S DIR(0)="E" D ^DIR I $D(DIRUT)!($D(DUOUT)) S IBQ=1
  1.  Q
  1.  ;
  1. SSN(X) ; - Format the SSN.
  1.  Q $S(X]"":$E(X,1,3)_"-"_$E(X,4,5)_"-"_$E(X,6,10),1:"")
  1.  ;
  1. DTE(X) ; - Format date (MMM DD,YYYY).
  1.  S:'X X="" S Y=X X ^DD("DD") Q Y