IBJDB22 ;ALB/RB - REASONS NOT BILLABLE REPORT (PRINT) ;19-JUN-00
;;2.0;INTEGRATED BILLING;**123,159,399**;21-MAR-94;Build 8
;
EN ; - Entry point from IBJDB21.
;
; - Extract summary data.
I $G(IBXTRACT) D EXTMO(.IB) G ENQ
;
S (IBQ,ECNT,ETOT,SCNT,STOT)=0 D NOW^%DTC S IBRUN=$$DAT2^IBOUTL(%)
;
S IBDIV="" I 'IBSD S VAUTD(0)=""
F S IBDIV=$O(VAUTD(IBDIV)) Q:IBDIV="" D I IBQ Q
. F IBEP=1:1:4 I IBSEL[IBEP D I IBQ Q
. . D @($S(IBRPT="D":"DET",1:"SUM"))
;
I IBQ G ENQ
;
I 'IBQ,IBRPT="D" D
. S IBDIV="" I 'IBSD S VAUTD(0)=""
. F S IBDIV=$O(VAUTD(IBDIV)) Q:IBDIV="" D I IBQ Q
. . F IBEP=1:1:4 I IBSEL[IBEP D SUM I IBQ Q
;
ENQ K %,IB0,IBDH,IBDIV,IBEP,IBEPH,IBN,IBP,IBPAG,IBPT,IBQ,IBRT,IBRUN,IBSORT
K IBT1,IBU,GTOT,ECNT,ETOT,SCNT,STOT
Q
;
DET ; - Print detailed report.
I '$D(^TMP("IBJDB2",$J,IBDIV,IBEP)) D D PAUSE Q
. D HDR Q:IBQ W !!,"No entries for this episode.",!
S IBT1=0,(IBSORT1,IBPT,IB0)=""
F S IBSORT1=$O(^TMP("IBJDB2",$J,IBDIV,IBEP,IBSORT1)) Q:IBSORT1="" D Q:IBQ
. D HDR Q:IBQ
. F S IBPT=$O(^TMP("IBJDB2",$J,IBDIV,IBEP,IBSORT1,IBPT)) Q:IBPT="" S IBP=$G(^(IBPT)) D Q:IBQ
. . I $Y>(IOSL-8) D PAUSE Q:IBQ D HDR Q:IBQ
. . D WPAT
. . F S IB0=$O(^TMP("IBJDB2",$J,IBDIV,IBEP,IBSORT1,IBPT,IB0)) Q:IB0="" S IBN=$G(^(IB0)) D Q:IBQ
. . . I $Y>(IOSL-8) D PAUSE Q:IBQ D HDR Q:IBQ D WPAT
. . . W ?45,$$DTE(+IBN),?55,$$DTE($P(IBN,U,2))
. . . I $P(IBN,U,4)'="" W ?65,$$DTE($P(IBN,U,3)),?76,$E($P(IBN,U,4),1,19)
. . . E W ?65,$$DTE($P(IBN,U,2)) W ?76,"POSTMASTER"
. . . S IBU=5 S:12[IBEP IBU=$S(IBSORT="R":6,1:IBU)
. . . I 12[IBEP W ?97,$E($P(IBN,U,IBU),1,25),?124,$J($P(IBN,U,8),8,2),!
. . . I 34[IBEP,+$P(IBN,U,11)>0 W ?99,$J($P(IBN,U,8),8,2) F X=2:1:$P($P(IBN,U,11),";",1)+1 W ?114,$P($P(IBN,U,11),";",X)_" "
. . . I 34[IBEP,+$P(IBN,U,11)<0 W ?99,$J($P(IBN,U,8),8,2),!
. . . I 34[IBEP,+$P(IBN,U,11)>0 W !
. . . I $P(IBN,U,9)]"" W ?15,"Comments: ",$P(IBN,U,9) W:12'[IBEP !
. . . I 12[IBEP,+$P(IBN,U,11)>0,$P(IBN,U,9)="" W ?27,"Related Bills: " F X=2:1:$P($P(IBN,U,11),";",1)+1 W ?41,$P($P(IBN,U,11),";",X)_" "
. . . I 2[IBEP,$P(IBN,U,10)'="" W ?76,"Nx Adm:",?85,$P(IBN,U,10)
. . . I 12[IBEP,+$P(IBN,U,11)>0,$P(IBN,U,9)'="" W !,?27,"Related Bills: " F X=2:1:$P($P(IBN,U,11),";",1)+1 W ?41,$P($P(IBN,U,11),";",X)_" "
. . . I 12[IBEP W ?97,$E($P(IBN,U,$S("PR"[IBSORT:7,1:6)),1,25),!
. . . S SCNT=SCNT+1,ECNT=ECNT+1
. . . S STOT=STOT+$P(IBN,U,8),ETOT=ETOT+$P(IBN,U,8)
. I 'IBQ D TOT2 I $O(^TMP("IBJDB2",$J,IBDIV,IBEP,IBSORT1))'="" D PAUSE Q
I 'IBQ D TOT1,PAUSE
;
DETQ Q
;
EXTMO(IBSM) ; Extract/transmit data to DM Extract Module
; IBSM - Array containing the summary information
;
N I,IB,IBI,IBJ,IBLST,IBR,IBRNB,IBSQ,IBTR,IBTP,IBZ,RNBC,RNBN
;
F I=1:1 S RNBN=$P($T(RNB+I),";;",2,99) Q:RNBN="" D
. S RNBC=$O(^IBE(356.8,"B",RNBN,0)) Q:'RNBC
. S IBTR(RNBC)=I
;
S IBRNB="",IBLST=$O(^IBE(356.8,999),-1)*2
F IBTP=1:1:4 D
. F IBJ=1:1:IBLST,999,1000 S IB(IBTP,IBJ)=$S(IBJ#2:0,1:"0.00")
. F S IBRNB=$O(IBSM(0,IBTP,IBRNB)) Q:IBRNB="" D
. . I '$D(IBTR(IBRNB)) Q
. . S IBSQ=$S(IBRNB<999:IBTR(IBRNB)*2-1,1:999)
. . S IBZ=$G(IBSM(0,IBTP,IBRNB))
. . S IB(IBTP,IBSQ)=+IBZ
. . S IB(IBTP,IBSQ+1)=$FN(+$P(IBZ,"^",2),"",2)
. F I=1:1:3 D E^IBJDE(21+(IBTP*3)+I,0)
. K IB(IBTP)
;
Q
;
SUM ; - Print summary line(s).
I '$D(IB(IBDIV,IBEP)) D D PAUSE Q
. D SUMH W !!?14,"No statistics available."
D SUMH Q:IBQ
S IBRNB=0 F S IBRNB=$O(IB(IBDIV,IBEP,IBRNB)) Q:'IBRNB D Q:IBQ
. S IBN=IB(IBDIV,IBEP,IBRNB)
. W !?14,$P($G(^IBE(356.8,IBRNB,0)),U),?48,$J(+IBN,5),?57,$J($P(IBN,U,2),9,2)
. S $P(GTOT,U)=$P(GTOT,U)+IBN,$P(GTOT,U,2)=$P(GTOT,U,2)+$P(IBN,U,2)
D SUMT
;
Q
;
SUMH ; - Print summary header.
I $E(IOST,1,2)="C-"!$G(IBPAG) W @IOF,*13
S IBPAG=$G(IBPAG)+1 W ?68,"Page: ",IBPAG
S IBEPH="REASONS NOT BILLABLE SUMMARY/"_IBEPS(IBEP)
W !!?(80-$L(IBEPH))\2,IBEPH
I IBDIV D
.S IBDH="Division: "_$P($G(^DG(40.8,IBDIV,0)),U)
.W !?(80-$L(IBDH)\2),IBDH
;
W !?22,"Period : from ",$$DTE(IBBDT)," thru ",$$DTE(IBEDT),!
W !?24,"Run Date: ",IBRUN
W !!?46,"No. of",?61,"Total",!?14,"RNB Category",?46,"Entries"
W ?60,"Amount",!?14,$$DASH(52)
S GTOT="0^0",IBQ=$$STOP^IBOUTL("Reasons Not Billable Summary")
Q
;
SUMT ; - Print summary totals.
W !?47,"-------------------"
W !?33,"Grand Totals:",?47,$J(+GTOT,6),?56,$J($P(GTOT,U,2),10,2) D PAUSE
Q
;
HDR ; - Write the detailed report header.
I $E(IOST,1,2)="C-"!$G(IBPAG) W @IOF,*13
S IBPAG=$G(IBPAG)+1 W "Reasons Not Billable (RNB) Report "
W ?88,"Run Date: ",IBRUN,?123,"Page: ",$J(IBPAG,3)
S X=IBE(IBEP)_" events by "
I 1234[IBEP D
. S X=X_$S(IBSORT="P":"provider",IBSORT="S":"specialty",1:"RNB category")
. I $G(IBSORT1)'="" S X=X_" ("_IBSORT1_")"
E S X=X_"RNB category"
S X=X_" from "_$$DTE(IBBDT)_" thru "_$$DTE(IBEDT)_" ("_IBD_")"
I 12[IBEP D
. I IBSORT'="R" D
. . S X=X_" / "_$S(IBSRNB="S":"SPECIFIC",1:"ALL")_" REASONS NOT BILLABLE"
. I IBSORT'="P" D
. . S X=X_" / "_$S(IBSPRV="S":"SPECIFIC",1:"ALL")_" PROVIDERS"
. I IBSORT'="S",IBEP=1 D
. . S X=X_" / "_$S(IBSISP="S":"SPECIFIC",1:"ALL")_" SPECIALTIES"
. I IBSORT'="S",IBEP=2 D
. . S X=X_" / "_$S(IBSOSP="S":"SPECIFIC",1:"ALL")_" SPECIALTIES"
F I=1:1 W !,$E(X,1,132) S X=$E(X,133,999) I X="" Q
;
I IBDIV W !,"Division: ",$P($G(^DG(40.8,IBDIV,0)),U)
W !!?26,"Last",?32,"Insurance",?45,"Episode Date Dte Last"
I 12[IBEP W ?97,$S("PS"[IBSORT:"RNB Category",1:"Provider")
W !,"Patient",?26,"4SSN",?32,"Carrier"
W ?45,"Date Entered Edited Last Edited By"
I 12[IBEP W ?97,$S("PR"[IBSORT:"Specialty",1:"Provider")
;
I 34[IBEP W ?101,"Amount",?114,"Related Bills",!,$$DASH(IOM),!
E W ?126,"Amount",!,$$DASH(IOM),!
S IBQ=$$STOP^IBOUTL("Reasons Not Billable Report")
Q
;
WPAT ; - Write patient data.
W $P(IBPT,"@@"),?26,$P(IBPT,"@@",2),?32,$E($P(IBP,U),1,12)
Q
;
TOT1 ; - Print episode totals.
I 34[IBEP W !?97,"----------",!
E W !?122,"----------",!
I 34[IBEP W ?55
E W ?80
W "TOTAL FOR EPISODE - Count: ",$J(ECNT,5)," Amount: ",$J(ETOT,10,2)
S (ECNT,ETOT)=0
Q
;
TOT2 ; - Print sub-totals.
I 34[IBEP W ?98,"---------",!
E W ?123,"---------",!
I 34[IBEP W ?60
E W ?85
W "TOTAL EVENTS - Count: ",$J(SCNT,4)," Amount: ",$J(STOT,9,2),!
S (SCNT,STOT)=0
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 S:$D(DIRUT)!($D(DUOUT)) IBQ=1
Q
;
DTE(X) ; - Format the date.
Q $S(X:$E(X,4,5)_"/"_$E(X,6,7)_"/"_$E(X,2,3),1:"")
;
RNB ; - Reasons Not Billable
;;NOT INSURED
;;SC TREATMENT
;;AGENT ORANGE
;;IONIZING RADIATION
;;ENV. CONTAM.
;;SERVICE NOT COVERED
;;COVERAGE CANCELED
;;NEEDS SC DETERMINATION
;;NON-BILLABLE APPOINTMENT TYPE
;;INVALID PRESCRIPTION ENTRY
;;REFILL ON VISIT DATE
;;PRESCRIPTION DELETED
;;PRESCRIPTION NOT RELEASED
;;DRUG NOT BILLABLE
;;HMO POLICY
;;REFUSES TO SIGN RELEASE (ROI)
;;NON-BILLABLE STOP CODE
;;RESEARCH VISIT
;;BILL PURGED
;;NON-BILLABLE CLINIC
;;MILITARY SEXUAL TRAUMA
;;CREDENTIALING ISSUE
;;INSUFFICIENT DOCUMENTATION
;;NO DOCUMENTATION
;;NON-BILLABLE PROVIDER (RESID.)
;;NON-BILLABLE PROVIDER (OTHER)
;;OTHER COMPLIANCE
;;OUT OF NETWORK (PPO)
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBJDB22 7402 printed Apr 09, 2024@21:32:14 Page 2
IBJDB22 ;ALB/RB - REASONS NOT BILLABLE REPORT (PRINT) ;19-JUN-00
+1 ;;2.0;INTEGRATED BILLING;**123,159,399**;21-MAR-94;Build 8
+2 ;
EN ; - Entry point from IBJDB21.
+1 ;
+2 ; - Extract summary data.
+3 IF $GET(IBXTRACT)
DO EXTMO(.IB)
GOTO ENQ
+4 ;
+5 SET (IBQ,ECNT,ETOT,SCNT,STOT)=0
DO NOW^%DTC
SET IBRUN=$$DAT2^IBOUTL(%)
+6 ;
+7 SET IBDIV=""
IF 'IBSD
SET VAUTD(0)=""
+8 FOR
SET IBDIV=$ORDER(VAUTD(IBDIV))
if IBDIV=""
QUIT
Begin DoDot:1
+9 FOR IBEP=1:1:4
IF IBSEL[IBEP
Begin DoDot:2
+10 DO @($SELECT(IBRPT="D":"DET",1:"SUM"))
End DoDot:2
IF IBQ
QUIT
End DoDot:1
IF IBQ
QUIT
+11 ;
+12 IF IBQ
GOTO ENQ
+13 ;
+14 IF 'IBQ
IF IBRPT="D"
Begin DoDot:1
+15 SET IBDIV=""
IF 'IBSD
SET VAUTD(0)=""
+16 FOR
SET IBDIV=$ORDER(VAUTD(IBDIV))
if IBDIV=""
QUIT
Begin DoDot:2
+17 FOR IBEP=1:1:4
IF IBSEL[IBEP
DO SUM
IF IBQ
QUIT
End DoDot:2
IF IBQ
QUIT
End DoDot:1
+18 ;
ENQ KILL %,IB0,IBDH,IBDIV,IBEP,IBEPH,IBN,IBP,IBPAG,IBPT,IBQ,IBRT,IBRUN,IBSORT
+1 KILL IBT1,IBU,GTOT,ECNT,ETOT,SCNT,STOT
+2 QUIT
+3 ;
DET ; - Print detailed report.
+1 IF '$DATA(^TMP("IBJDB2",$JOB,IBDIV,IBEP))
Begin DoDot:1
+2 DO HDR
if IBQ
QUIT
WRITE !!,"No entries for this episode.",!
End DoDot:1
DO PAUSE
QUIT
+3 SET IBT1=0
SET (IBSORT1,IBPT,IB0)=""
+4 FOR
SET IBSORT1=$ORDER(^TMP("IBJDB2",$JOB,IBDIV,IBEP,IBSORT1))
if IBSORT1=""
QUIT
Begin DoDot:1
+5 DO HDR
if IBQ
QUIT
+6 FOR
SET IBPT=$ORDER(^TMP("IBJDB2",$JOB,IBDIV,IBEP,IBSORT1,IBPT))
if IBPT=""
QUIT
SET IBP=$GET(^(IBPT))
Begin DoDot:2
+7 IF $Y>(IOSL-8)
DO PAUSE
if IBQ
QUIT
DO HDR
if IBQ
QUIT
+8 DO WPAT
+9 FOR
SET IB0=$ORDER(^TMP("IBJDB2",$JOB,IBDIV,IBEP,IBSORT1,IBPT,IB0))
if IB0=""
QUIT
SET IBN=$GET(^(IB0))
Begin DoDot:3
+10 IF $Y>(IOSL-8)
DO PAUSE
if IBQ
QUIT
DO HDR
if IBQ
QUIT
DO WPAT
+11 WRITE ?45,$$DTE(+IBN),?55,$$DTE($PIECE(IBN,U,2))
+12 IF $PIECE(IBN,U,4)'=""
WRITE ?65,$$DTE($PIECE(IBN,U,3)),?76,$EXTRACT($PIECE(IBN,U,4),1,19)
+13 IF '$TEST
WRITE ?65,$$DTE($PIECE(IBN,U,2))
WRITE ?76,"POSTMASTER"
+14 SET IBU=5
if 12[IBEP
SET IBU=$SELECT(IBSORT="R":6,1:IBU)
+15 IF 12[IBEP
WRITE ?97,$EXTRACT($PIECE(IBN,U,IBU),1,25),?124,$JUSTIFY($PIECE(IBN,U,8),8,2),!
+16 IF 34[IBEP
IF +$PIECE(IBN,U,11)>0
WRITE ?99,$JUSTIFY($PIECE(IBN,U,8),8,2)
FOR X=2:1:$PIECE($PIECE(IBN,U,11),";",1)+1
WRITE ?114,$PIECE($PIECE(IBN,U,11),";",X)_" "
+17 IF 34[IBEP
IF +$PIECE(IBN,U,11)<0
WRITE ?99,$JUSTIFY($PIECE(IBN,U,8),8,2),!
+18 IF 34[IBEP
IF +$PIECE(IBN,U,11)>0
WRITE !
+19 IF $PIECE(IBN,U,9)]""
WRITE ?15,"Comments: ",$PIECE(IBN,U,9)
if 12'[IBEP
WRITE !
+20 IF 12[IBEP
IF +$PIECE(IBN,U,11)>0
IF $PIECE(IBN,U,9)=""
WRITE ?27,"Related Bills: "
FOR X=2:1:$PIECE($PIECE(IBN,U,11),";",1)+1
WRITE ?41,$PIECE($PIECE(IBN,U,11),";",X)_" "
+21 IF 2[IBEP
IF $PIECE(IBN,U,10)'=""
WRITE ?76,"Nx Adm:",?85,$PIECE(IBN,U,10)
+22 IF 12[IBEP
IF +$PIECE(IBN,U,11)>0
IF $PIECE(IBN,U,9)'=""
WRITE !,?27,"Related Bills: "
FOR X=2:1:$PIECE($PIECE(IBN,U,11),";",1)+1
WRITE ?41,$PIECE($PIECE(IBN,U,11),";",X)_" "
+23 IF 12[IBEP
WRITE ?97,$EXTRACT($PIECE(IBN,U,$SELECT("PR"[IBSORT:7,1:6)),1,25),!
+24 SET SCNT=SCNT+1
SET ECNT=ECNT+1
+25 SET STOT=STOT+$PIECE(IBN,U,8)
SET ETOT=ETOT+$PIECE(IBN,U,8)
End DoDot:3
if IBQ
QUIT
End DoDot:2
if IBQ
QUIT
+26 IF 'IBQ
DO TOT2
IF $ORDER(^TMP("IBJDB2",$JOB,IBDIV,IBEP,IBSORT1))'=""
DO PAUSE
QUIT
End DoDot:1
if IBQ
QUIT
+27 IF 'IBQ
DO TOT1
DO PAUSE
+28 ;
DETQ QUIT
+1 ;
EXTMO(IBSM) ; Extract/transmit data to DM Extract Module
+1 ; IBSM - Array containing the summary information
+2 ;
+3 NEW I,IB,IBI,IBJ,IBLST,IBR,IBRNB,IBSQ,IBTR,IBTP,IBZ,RNBC,RNBN
+4 ;
+5 FOR I=1:1
SET RNBN=$PIECE($TEXT(RNB+I),";;",2,99)
if RNBN=""
QUIT
Begin DoDot:1
+6 SET RNBC=$ORDER(^IBE(356.8,"B",RNBN,0))
if 'RNBC
QUIT
+7 SET IBTR(RNBC)=I
End DoDot:1
+8 ;
+9 SET IBRNB=""
SET IBLST=$ORDER(^IBE(356.8,999),-1)*2
+10 FOR IBTP=1:1:4
Begin DoDot:1
+11 FOR IBJ=1:1:IBLST,999,1000
SET IB(IBTP,IBJ)=$SELECT(IBJ#2:0,1:"0.00")
+12 FOR
SET IBRNB=$ORDER(IBSM(0,IBTP,IBRNB))
if IBRNB=""
QUIT
Begin DoDot:2
+13 IF '$DATA(IBTR(IBRNB))
QUIT
+14 SET IBSQ=$SELECT(IBRNB<999:IBTR(IBRNB)*2-1,1:999)
+15 SET IBZ=$GET(IBSM(0,IBTP,IBRNB))
+16 SET IB(IBTP,IBSQ)=+IBZ
+17 SET IB(IBTP,IBSQ+1)=$FNUMBER(+$PIECE(IBZ,"^",2),"",2)
End DoDot:2
+18 FOR I=1:1:3
DO E^IBJDE(21+(IBTP*3)+I,0)
+19 KILL IB(IBTP)
End DoDot:1
+20 ;
+21 QUIT
+22 ;
SUM ; - Print summary line(s).
+1 IF '$DATA(IB(IBDIV,IBEP))
Begin DoDot:1
+2 DO SUMH
WRITE !!?14,"No statistics available."
End DoDot:1
DO PAUSE
QUIT
+3 DO SUMH
if IBQ
QUIT
+4 SET IBRNB=0
FOR
SET IBRNB=$ORDER(IB(IBDIV,IBEP,IBRNB))
if 'IBRNB
QUIT
Begin DoDot:1
+5 SET IBN=IB(IBDIV,IBEP,IBRNB)
+6 WRITE !?14,$PIECE($GET(^IBE(356.8,IBRNB,0)),U),?48,$JUSTIFY(+IBN,5),?57,$JUSTIFY($PIECE(IBN,U,2),9,2)
+7 SET $PIECE(GTOT,U)=$PIECE(GTOT,U)+IBN
SET $PIECE(GTOT,U,2)=$PIECE(GTOT,U,2)+$PIECE(IBN,U,2)
End DoDot:1
if IBQ
QUIT
+8 DO SUMT
+9 ;
+10 QUIT
+11 ;
SUMH ; - Print summary header.
+1 IF $EXTRACT(IOST,1,2)="C-"!$GET(IBPAG)
WRITE @IOF,*13
+2 SET IBPAG=$GET(IBPAG)+1
WRITE ?68,"Page: ",IBPAG
+3 SET IBEPH="REASONS NOT BILLABLE SUMMARY/"_IBEPS(IBEP)
+4 WRITE !!?(80-$LENGTH(IBEPH))\2,IBEPH
+5 IF IBDIV
Begin DoDot:1
+6 SET IBDH="Division: "_$PIECE($GET(^DG(40.8,IBDIV,0)),U)
+7 WRITE !?(80-$LENGTH(IBDH)\2),IBDH
End DoDot:1
+8 ;
+9 WRITE !?22,"Period : from ",$$DTE(IBBDT)," thru ",$$DTE(IBEDT),!
+10 WRITE !?24,"Run Date: ",IBRUN
+11 WRITE !!?46,"No. of",?61,"Total",!?14,"RNB Category",?46,"Entries"
+12 WRITE ?60,"Amount",!?14,$$DASH(52)
+13 SET GTOT="0^0"
SET IBQ=$$STOP^IBOUTL("Reasons Not Billable Summary")
+14 QUIT
+15 ;
SUMT ; - Print summary totals.
+1 WRITE !?47,"-------------------"
+2 WRITE !?33,"Grand Totals:",?47,$JUSTIFY(+GTOT,6),?56,$JUSTIFY($PIECE(GTOT,U,2),10,2)
DO PAUSE
+3 QUIT
+4 ;
HDR ; - Write the detailed report header.
+1 IF $EXTRACT(IOST,1,2)="C-"!$GET(IBPAG)
WRITE @IOF,*13
+2 SET IBPAG=$GET(IBPAG)+1
WRITE "Reasons Not Billable (RNB) Report "
+3 WRITE ?88,"Run Date: ",IBRUN,?123,"Page: ",$JUSTIFY(IBPAG,3)
+4 SET X=IBE(IBEP)_" events by "
+5 IF 1234[IBEP
Begin DoDot:1
+6 SET X=X_$SELECT(IBSORT="P":"provider",IBSORT="S":"specialty",1:"RNB category")
+7 IF $GET(IBSORT1)'=""
SET X=X_" ("_IBSORT1_")"
End DoDot:1
+8 IF '$TEST
SET X=X_"RNB category"
+9 SET X=X_" from "_$$DTE(IBBDT)_" thru "_$$DTE(IBEDT)_" ("_IBD_")"
+10 IF 12[IBEP
Begin DoDot:1
+11 IF IBSORT'="R"
Begin DoDot:2
+12 SET X=X_" / "_$SELECT(IBSRNB="S":"SPECIFIC",1:"ALL")_" REASONS NOT BILLABLE"
End DoDot:2
+13 IF IBSORT'="P"
Begin DoDot:2
+14 SET X=X_" / "_$SELECT(IBSPRV="S":"SPECIFIC",1:"ALL")_" PROVIDERS"
End DoDot:2
+15 IF IBSORT'="S"
IF IBEP=1
Begin DoDot:2
+16 SET X=X_" / "_$SELECT(IBSISP="S":"SPECIFIC",1:"ALL")_" SPECIALTIES"
End DoDot:2
+17 IF IBSORT'="S"
IF IBEP=2
Begin DoDot:2
+18 SET X=X_" / "_$SELECT(IBSOSP="S":"SPECIFIC",1:"ALL")_" SPECIALTIES"
End DoDot:2
End DoDot:1
+19 FOR I=1:1
WRITE !,$EXTRACT(X,1,132)
SET X=$EXTRACT(X,133,999)
IF X=""
QUIT
+20 ;
+21 IF IBDIV
WRITE !,"Division: ",$PIECE($GET(^DG(40.8,IBDIV,0)),U)
+22 WRITE !!?26,"Last",?32,"Insurance",?45,"Episode Date Dte Last"
+23 IF 12[IBEP
WRITE ?97,$SELECT("PS"[IBSORT:"RNB Category",1:"Provider")
+24 WRITE !,"Patient",?26,"4SSN",?32,"Carrier"
+25 WRITE ?45,"Date Entered Edited Last Edited By"
+26 IF 12[IBEP
WRITE ?97,$SELECT("PR"[IBSORT:"Specialty",1:"Provider")
+27 ;
+28 IF 34[IBEP
WRITE ?101,"Amount",?114,"Related Bills",!,$$DASH(IOM),!
+29 IF '$TEST
WRITE ?126,"Amount",!,$$DASH(IOM),!
+30 SET IBQ=$$STOP^IBOUTL("Reasons Not Billable Report")
+31 QUIT
+32 ;
WPAT ; - Write patient data.
+1 WRITE $PIECE(IBPT,"@@"),?26,$PIECE(IBPT,"@@",2),?32,$EXTRACT($PIECE(IBP,U),1,12)
+2 QUIT
+3 ;
TOT1 ; - Print episode totals.
+1 IF 34[IBEP
WRITE !?97,"----------",!
+2 IF '$TEST
WRITE !?122,"----------",!
+3 IF 34[IBEP
WRITE ?55
+4 IF '$TEST
WRITE ?80
+5 WRITE "TOTAL FOR EPISODE - Count: ",$JUSTIFY(ECNT,5)," Amount: ",$JUSTIFY(ETOT,10,2)
+6 SET (ECNT,ETOT)=0
+7 QUIT
+8 ;
TOT2 ; - Print sub-totals.
+1 IF 34[IBEP
WRITE ?98,"---------",!
+2 IF '$TEST
WRITE ?123,"---------",!
+3 IF 34[IBEP
WRITE ?60
+4 IF '$TEST
WRITE ?85
+5 WRITE "TOTAL EVENTS - Count: ",$JUSTIFY(SCNT,4)," Amount: ",$JUSTIFY(STOT,9,2),!
+6 SET (SCNT,STOT)=0
+7 QUIT
+8 ;
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 ;
DTE(X) ; - Format the date.
+1 QUIT $SELECT(X:$EXTRACT(X,4,5)_"/"_$EXTRACT(X,6,7)_"/"_$EXTRACT(X,2,3),1:"")
+2 ;
RNB ; - Reasons Not Billable
+1 ;;NOT INSURED
+2 ;;SC TREATMENT
+3 ;;AGENT ORANGE
+4 ;;IONIZING RADIATION
+5 ;;ENV. CONTAM.
+6 ;;SERVICE NOT COVERED
+7 ;;COVERAGE CANCELED
+8 ;;NEEDS SC DETERMINATION
+9 ;;NON-BILLABLE APPOINTMENT TYPE
+10 ;;INVALID PRESCRIPTION ENTRY
+11 ;;REFILL ON VISIT DATE
+12 ;;PRESCRIPTION DELETED
+13 ;;PRESCRIPTION NOT RELEASED
+14 ;;DRUG NOT BILLABLE
+15 ;;HMO POLICY
+16 ;;REFUSES TO SIGN RELEASE (ROI)
+17 ;;NON-BILLABLE STOP CODE
+18 ;;RESEARCH VISIT
+19 ;;BILL PURGED
+20 ;;NON-BILLABLE CLINIC
+21 ;;MILITARY SEXUAL TRAUMA
+22 ;;CREDENTIALING ISSUE
+23 ;;INSUFFICIENT DOCUMENTATION
+24 ;;NO DOCUMENTATION
+25 ;;NON-BILLABLE PROVIDER (RESID.)
+26 ;;NON-BILLABLE PROVIDER (OTHER)
+27 ;;OTHER COMPLIANCE
+28 ;;OUT OF NETWORK (PPO)
