IBJDB13 ;ALB/CPM - BILLING LAG TIME REPORT (INPT PRINT) ; 02-JAN-97
;;2.0;INTEGRATED BILLING;**100,118**;21-MAR-94
;
INP ; - Print the inpatient report.
F IBX=5,"6I",9,10,"7I","8I",11,6,7,8 I IBSEL[(","_IBX_",") D Q:IBQ
.I '$D(^TMP("IBJDB1",$J,IBDIV,"IN",IBX)) D Q
..S IBPAG=0 D INPH I IBQ Q
..W !!,"There was no ",$$TITLE^IBJDB1(+IBX,0)
..I IBX["I" W " (Late Insurance)"
..W !," claim activity during this period." D PAUSE
.;
.S IBPAG=0 D INPH I IBQ Q
.K IBCT,IBTL S (IBCT(IBX),IBTL(IBX))=0,IBX1=""
.F S IBX1=$O(^TMP("IBJDB1",$J,IBDIV,"IN",IBX,IBX1)) Q:IBX1="" D Q:IBQ
..I $Y>(IOSL-2) D PAUSE Q:IBQ D INPH Q:IBQ
..D WPATI S (IBH,IBX2)=0
..F S IBX2=$O(^TMP("IBJDB1",$J,IBDIV,"IN",IBX,IBX1,IBX2)) Q:'IBX2 S IBX3=$G(^(IBX2)) D Q:IBQ
...I $Y>(IOSL-4) D PAUSE Q:IBQ D INPH,WPATI Q:IBQ S IBH=0
...;
...; - Write bill #, dates and total days.
...W:IBH ! I 'IBH S IBH=1
...W ?40,$P(IBX3,U),?50,$$DTE($P(IBX3,U,2)),$P(IBX3,U,5)
...W ?63,$$DTE($P(IBX3,U,3)),?76,$J($P(IBX3,U,4),4)
...S IBCT(IBX)=IBCT(IBX)+1,IBTL(IBX)=IBTL(IBX)+$P(IBX3,U,4)
.;
.D AVG,PAUSE
;
INPQ Q
;
WPATI ; - Write inpatient patient data.
W !,$E($P(IBX1,"@@"),1,25),?27,$$SSN($P(IBX1,"@@",2))
Q
;
INPH ; - Write the inpatient detail report header.
W @IOF,*13 S IBPAG=$G(IBPAG)+1
W !,"Inpatient Billing Lag Time Report"
W ?48,IBRUN,?72,"Page ",$J(IBPAG,3)
W !,$$TITLE^IBJDB1(+IBX,0) I IBX["I" W " (Late Insurance)"
W !,"Claims w/activity from ",$$DTE(IBBDT)," to ",$$DTE(IBEDT)
W " (*=Insurance found after trmt)"
W:IBDIV !,"Division: ",$P($G(^DG(40.8,IBDIV,0)),U) W !!
W:IBX=5!(IBX[7)!(IBX[8)!(IBX=11) ?50,"Date of"
W:IBX[6 ?50,"Date PTF" W:IBX=9!(IBX=10) ?50,"Date Claim"
W:IBX=5 ?63,"Date PTF" W:IBX[7!(IBX=10) ?63,"Date of"
W:IBX[6!(IBX=9) ?63,"Date Claim"
W ?76,"# of",!,"Patient",?27,"SSN",?40,"Bill #"
W:IBX=5!(IBX[7)!(IBX[8) ?50,"Discharge"
W:IBX[6 ?50,"Transmitted" W:IBX=9 ?50,"Authorized"
W:IBX=10 ?51,"Activated" W:IBX=11 ?50,"First Paymt"
W:IBX=5 ?63,"Transmitted" W:IBX[6 ?63,"Authorized"
W:IBX[7!(IBX=10) ?63,"First Paymt" W:IBX[8!(IBX=11) ?63,"Date Closed"
W:IBX=9 ?64,"Activated" W ?76,"Days",!,$$DASH(80)
S IBQ=$$STOP^IBOUTL("Billing Lag Time Report")
Q
;
AVG ; - Write total days and average line.
W !?75,"-----",!,"Average Number of Days for",?75,$J(IBTL(IBX),5)
W !,$$TITLE^IBJDB1(+IBX,0),$S(IBX["I":" (Late Ins)",1:""),": "
W $J($S('IBCT(IBX):0,1:IBTL(IBX)/IBCT(IBX)),0,2)
W " (",IBCT(IBX)," claim",$S(IBCT(IBX)>1:"s",1:""),")"
Q
;
DASH(X) ; - Return a dashed line.
Q $TR($J("",X)," ","=")
;
PAUSE ; - Page break.
I $E(IOST,1,2)'="C-" Q
N IBX,DIR,DIRUT,DUOUT,DTOUT,DIROUT,X,Y
F IBX=$Y:1:(IOSL-3) W !
S DIR(0)="E" D ^DIR I $D(DIRUT)!($D(DUOUT)) S IBQ=1
Q
;
SSN(X) ; - Format the SSN.
Q $S(X]"":$E(X,1,3)_"-"_$E(X,4,5)_"-"_$E(X,6,10),1:"")
;
DTE(X) ; - Format date (MMM DD,YYYY).
S:'X X="" S Y=X X ^DD("DD") Q Y
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBJDB13 2946 printed Apr 09, 2024@21:37:24 Page 2
IBJDB13 ;ALB/CPM - BILLING LAG TIME REPORT (INPT PRINT) ; 02-JAN-97
+1 ;;2.0;INTEGRATED BILLING;**100,118**;21-MAR-94
+2 ;
INP ; - Print the inpatient report.
+1 FOR IBX=5,"6I",9,10,"7I","8I",11,6,7,8
IF IBSEL[(","_IBX_",")
Begin DoDot:1
+2 IF '$DATA(^TMP("IBJDB1",$JOB,IBDIV,"IN",IBX))
Begin DoDot:2
+3 SET IBPAG=0
DO INPH
IF IBQ
QUIT
+4 WRITE !!,"There was no ",$$TITLE^IBJDB1(+IBX,0)
+5 IF IBX["I"
WRITE " (Late Insurance)"
+6 WRITE !," claim activity during this period."
DO PAUSE
End DoDot:2
QUIT
+7 ;
+8 SET IBPAG=0
DO INPH
IF IBQ
QUIT
+9 KILL IBCT,IBTL
SET (IBCT(IBX),IBTL(IBX))=0
SET IBX1=""
+10 FOR
SET IBX1=$ORDER(^TMP("IBJDB1",$JOB,IBDIV,"IN",IBX,IBX1))
if IBX1=""
QUIT
Begin DoDot:2
+11 IF $Y>(IOSL-2)
DO PAUSE
if IBQ
QUIT
DO INPH
if IBQ
QUIT
+12 DO WPATI
SET (IBH,IBX2)=0
+13 FOR
SET IBX2=$ORDER(^TMP("IBJDB1",$JOB,IBDIV,"IN",IBX,IBX1,IBX2))
if 'IBX2
QUIT
SET IBX3=$GET(^(IBX2))
Begin DoDot:3
+14 IF $Y>(IOSL-4)
DO PAUSE
if IBQ
QUIT
DO INPH
DO WPATI
if IBQ
QUIT
SET IBH=0
+15 ;
+16 ; - Write bill #, dates and total days.
+17 if IBH
WRITE !
IF 'IBH
SET IBH=1
+18 WRITE ?40,$PIECE(IBX3,U),?50,$$DTE($PIECE(IBX3,U,2)),$PIECE(IBX3,U,5)
+19 WRITE ?63,$$DTE($PIECE(IBX3,U,3)),?76,$JUSTIFY($PIECE(IBX3,U,4),4)
+20 SET IBCT(IBX)=IBCT(IBX)+1
SET IBTL(IBX)=IBTL(IBX)+$PIECE(IBX3,U,4)
End DoDot:3
if IBQ
QUIT
End DoDot:2
if IBQ
QUIT
+21 ;
+22 DO AVG
DO PAUSE
End DoDot:1
if IBQ
QUIT
+23 ;
INPQ QUIT
+1 ;
WPATI ; - Write inpatient patient data.
+1 WRITE !,$EXTRACT($PIECE(IBX1,"@@"),1,25),?27,$$SSN($PIECE(IBX1,"@@",2))
+2 QUIT
+3 ;
INPH ; - Write the inpatient detail report header.
+1 WRITE @IOF,*13
SET IBPAG=$GET(IBPAG)+1
+2 WRITE !,"Inpatient Billing Lag Time Report"
+3 WRITE ?48,IBRUN,?72,"Page ",$JUSTIFY(IBPAG,3)
+4 WRITE !,$$TITLE^IBJDB1(+IBX,0)
IF IBX["I"
WRITE " (Late Insurance)"
+5 WRITE !,"Claims w/activity from ",$$DTE(IBBDT)," to ",$$DTE(IBEDT)
+6 WRITE " (*=Insurance found after trmt)"
+7 if IBDIV
WRITE !,"Division: ",$PIECE($GET(^DG(40.8,IBDIV,0)),U)
WRITE !!
+8 if IBX=5!(IBX[7)!(IBX[8)!(IBX=11)
WRITE ?50,"Date of"
+9 if IBX[6
WRITE ?50,"Date PTF"
if IBX=9!(IBX=10)
WRITE ?50,"Date Claim"
+10 if IBX=5
WRITE ?63,"Date PTF"
if IBX[7!(IBX=10)
WRITE ?63,"Date of"
+11 if IBX[6!(IBX=9)
WRITE ?63,"Date Claim"
+12 WRITE ?76,"# of",!,"Patient",?27,"SSN",?40,"Bill #"
+13 if IBX=5!(IBX[7)!(IBX[8)
WRITE ?50,"Discharge"
+14 if IBX[6
WRITE ?50,"Transmitted"
if IBX=9
WRITE ?50,"Authorized"
+15 if IBX=10
WRITE ?51,"Activated"
if IBX=11
WRITE ?50,"First Paymt"
+16 if IBX=5
WRITE ?63,"Transmitted"
if IBX[6
WRITE ?63,"Authorized"
+17 if IBX[7!(IBX=10)
WRITE ?63,"First Paymt"
if IBX[8!(IBX=11)
WRITE ?63,"Date Closed"
+18 if IBX=9
WRITE ?64,"Activated"
WRITE ?76,"Days",!,$$DASH(80)
+19 SET IBQ=$$STOP^IBOUTL("Billing Lag Time Report")
+20 QUIT
+21 ;
AVG ; - Write total days and average line.
+1 WRITE !?75,"-----",!,"Average Number of Days for",?75,$JUSTIFY(IBTL(IBX),5)
+2 WRITE !,$$TITLE^IBJDB1(+IBX,0),$SELECT(IBX["I":" (Late Ins)",1:""),": "
+3 WRITE $JUSTIFY($SELECT('IBCT(IBX):0,1:IBTL(IBX)/IBCT(IBX)),0,2)
+4 WRITE " (",IBCT(IBX)," claim",$SELECT(IBCT(IBX)>1:"s",1:""),")"
+5 QUIT
+6 ;
DASH(X) ; - Return a dashed line.
+1 QUIT $TRANSLATE($JUSTIFY("",X)," ","=")
+2 ;
PAUSE ; - Page break.
+1 IF $EXTRACT(IOST,1,2)'="C-"
QUIT
+2 NEW IBX,DIR,DIRUT,DUOUT,DTOUT,DIROUT,X,Y
+3 FOR IBX=$Y:1:(IOSL-3)
WRITE !
+4 SET DIR(0)="E"
DO ^DIR
IF $DATA(DIRUT)!($DATA(DUOUT))
SET IBQ=1
+5 QUIT
+6 ;
SSN(X) ; - Format the SSN.
+1 QUIT $SELECT(X]"":$EXTRACT(X,1,3)_"-"_$EXTRACT(X,4,5)_"-"_$EXTRACT(X,6,10),1:"")
+2 ;
DTE(X) ; - Format date (MMM DD,YYYY).
+1 if 'X
SET X=""
SET Y=X
XECUTE ^DD("DD")
QUIT Y
