IBJDF7 ;ALB/MR - REPAYMENT PLAN REPORT;14-AUG-00
;;2.0;INTEGRATED BILLING;**123**;21-MAR-94
;
EN ; - Option entry point.
S (IBEXCEL,IBTPT)=0,IBDAYS=1
;
; - Determine sorting (By name or Last 4 SSN)
S IBSN=$$SNL^IBJD() G ENQ:IBSN="^"
;
; - Determine the range
S X=$$INTV^IBJD("PATIENT "_$S(IBSN="N":"NAME",1:"LAST 4")) G ENQ:X="^"
S IBSNF=$P(X,"^",1),IBSNL=$P(X,"^",2),IBSNA=$P(X,"^",3)
;
CDPP ; - Select Current or Defaulted Payment Plan
S DIR(0)="SA^C:CURRENT;D:DEFAULTED;B:BOTH"
S DIR("A")="Print (C)URRENT, (D)EFAULTED Repayment Plans or (B)OTH: "
S DIR("B")="B",DIR("T")=300,DIR("L")=""
S (DIR("?"),DIR("??"))="^S IBOFF=23 D HELP^IBJDF7H"
W ! D ^DIR K DIR G:$D(DIRUT)!$D(DTOUT)!$D(DUOUT)!$D(DIROUT) ENQ
S IBPLN=Y K DIROUT,DTOUT,DUOUT,DIRUT G MCR:IBPLN="C"
;
; - Minimum number of days defaulted
S DIR(0)="NA^1:999",DIR("B")=1
S DIR("A")="Minimum number of days defaulted: "
S DIR("T")=300,DIR("?")="^S IBOFF=32 D HELP^IBJDF7H"
W ! D ^DIR K DIR G:$D(DTOUT)!$D(DUOUT)!$D(DIROUT) ENQ
S IBDAYS=+Y W:IBDAYS " day(s)" K DIROUT,DTOUT,DUOUT
;
MCR ; - Select MCCR or NON-MCCR Receivables
S DIR(0)="SA^M:MCCR;N:NON-MCCR"
S DIR("A")="Print (M)CCR or (N)ON-MCCR Receivables: "
S DIR("B")="M",DIR("T")=300,DIR("L")=""
S (DIR("?"),DIR("??"))="^S IBOFF=39 D HELP^IBJDF7H"
W ! D ^DIR K DIR G:$D(DIRUT)!$D(DTOUT)!$D(DUOUT)!$D(DIROUT) ENQ
S IBMCR=Y K DIROUT,DTOUT,DUOUT,DIRUT
;
; - Select a detailed or summary report.
D DS^IBJD G ENQ:IBRPT["^",DEV:IBRPT="S"
;
; - Determine whether to gather data for Excel report.
S IBEXCEL=$$EXCEL^IBJD() G ENQ:IBEXCEL="^",DEV:IBEXCEL
;
; - Print TOTAL by Patient?
S DIR(0)="Y",DIR("B")="YES",DIR("T")=300 W !
S DIR("A")="Do you want to include TOTALs by Patient"
S DIR("?")="^S IBOFF=55 D HELP^IBJDF7H"
D ^DIR K DIR G:$D(DIRUT)!$D(DTOUT)!$D(DUOUT)!$D(DIROUT) ENQ
S IBTPT=+Y K DIROUT,DTOUT,DUOUT,DIRUT
;
DEV ; - Select a device.
W !!,"This report requires a ",$S(IBRPT="S":80,1:132)," column printer."
;
I '$G(IBEXCEL) D
. W !!,"Note: This report will search through all active receivables."
. W !?6,"It is recommended that you queue it to run after normal business hours.",!
;
I $G(IBEXCEL) D EXMSG^IBJD
;
S %ZIS="QM" D ^%ZIS G:POP ENQ
I $D(IO("Q")) D G ENQ
.S ZTRTN="DQ^IBJDF7",ZTDESC="IB - REPAYMENT PLAN REPORT"
.S ZTSAVE("IB*")="" D ^%ZTLOAD
.I $G(ZTSK) W !!,"This job has been queued. The task no. is ",ZTSK,"."
.E W !!,"Unable to queue this job."
.K ZTSK,IO("Q") D HOME^%ZIS
;
U IO
;
DQ I $G(IBXTRACT) D E^IBJDE(38,1) ; Change extract status.
D ST^IBJDF71 ; Compile and print the report.
;
ENQ K DIROUT,DTOUT,DUOUT,DIRUT,I,IBDAYS,IBEXCEL,IBI,IBMCR,IBSN,IBSNF,IBSNL
K IBOFF,IBSNA,IBPLN,IBRPT,IBTPT,POP,X,ZTDESC,ZTRTN,ZTSAVE,Y,%ZIS
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBJDF7 2822 printed Apr 09, 2024@21:28:20 Page 2
IBJDF7 ;ALB/MR - REPAYMENT PLAN REPORT;14-AUG-00
+1 ;;2.0;INTEGRATED BILLING;**123**;21-MAR-94
+2 ;
EN ; - Option entry point.
+1 SET (IBEXCEL,IBTPT)=0
SET IBDAYS=1
+2 ;
+3 ; - Determine sorting (By name or Last 4 SSN)
+4 SET IBSN=$$SNL^IBJD()
if IBSN="^"
GOTO ENQ
+5 ;
+6 ; - Determine the range
+7 SET X=$$INTV^IBJD("PATIENT "_$SELECT(IBSN="N":"NAME",1:"LAST 4"))
if X="^"
GOTO ENQ
+8 SET IBSNF=$PIECE(X,"^",1)
SET IBSNL=$PIECE(X,"^",2)
SET IBSNA=$PIECE(X,"^",3)
+9 ;
CDPP ; - Select Current or Defaulted Payment Plan
+1 SET DIR(0)="SA^C:CURRENT;D:DEFAULTED;B:BOTH"
+2 SET DIR("A")="Print (C)URRENT, (D)EFAULTED Repayment Plans or (B)OTH: "
+3 SET DIR("B")="B"
SET DIR("T")=300
SET DIR("L")=""
+4 SET (DIR("?"),DIR("??"))="^S IBOFF=23 D HELP^IBJDF7H"
+5 WRITE !
DO ^DIR
KILL DIR
if $DATA(DIRUT)!$DATA(DTOUT)!$DATA(DUOUT)!$DATA(DIROUT)
GOTO ENQ
+6 SET IBPLN=Y
KILL DIROUT,DTOUT,DUOUT,DIRUT
if IBPLN="C"
GOTO MCR
+7 ;
+8 ; - Minimum number of days defaulted
+9 SET DIR(0)="NA^1:999"
SET DIR("B")=1
+10 SET DIR("A")="Minimum number of days defaulted: "
+11 SET DIR("T")=300
SET DIR("?")="^S IBOFF=32 D HELP^IBJDF7H"
+12 WRITE !
DO ^DIR
KILL DIR
if $DATA(DTOUT)!$DATA(DUOUT)!$DATA(DIROUT)
GOTO ENQ
+13 SET IBDAYS=+Y
if IBDAYS
WRITE " day(s)"
KILL DIROUT,DTOUT,DUOUT
+14 ;
MCR ; - Select MCCR or NON-MCCR Receivables
+1 SET DIR(0)="SA^M:MCCR;N:NON-MCCR"
+2 SET DIR("A")="Print (M)CCR or (N)ON-MCCR Receivables: "
+3 SET DIR("B")="M"
SET DIR("T")=300
SET DIR("L")=""
+4 SET (DIR("?"),DIR("??"))="^S IBOFF=39 D HELP^IBJDF7H"
+5 WRITE !
DO ^DIR
KILL DIR
if $DATA(DIRUT)!$DATA(DTOUT)!$DATA(DUOUT)!$DATA(DIROUT)
GOTO ENQ
+6 SET IBMCR=Y
KILL DIROUT,DTOUT,DUOUT,DIRUT
+7 ;
+8 ; - Select a detailed or summary report.
+9 DO DS^IBJD
if IBRPT["^"
GOTO ENQ
if IBRPT="S"
GOTO DEV
+10 ;
+11 ; - Determine whether to gather data for Excel report.
+12 SET IBEXCEL=$$EXCEL^IBJD()
if IBEXCEL="^"
GOTO ENQ
if IBEXCEL
GOTO DEV
+13 ;
+14 ; - Print TOTAL by Patient?
+15 SET DIR(0)="Y"
SET DIR("B")="YES"
SET DIR("T")=300
WRITE !
+16 SET DIR("A")="Do you want to include TOTALs by Patient"
+17 SET DIR("?")="^S IBOFF=55 D HELP^IBJDF7H"
+18 DO ^DIR
KILL DIR
if $DATA(DIRUT)!$DATA(DTOUT)!$DATA(DUOUT)!$DATA(DIROUT)
GOTO ENQ
+19 SET IBTPT=+Y
KILL DIROUT,DTOUT,DUOUT,DIRUT
+20 ;
DEV ; - Select a device.
+1 WRITE !!,"This report requires a ",$SELECT(IBRPT="S":80,1:132)," column printer."
+2 ;
+3 IF '$GET(IBEXCEL)
Begin DoDot:1
+4 WRITE !!,"Note: This report will search through all active receivables."
+5 WRITE !?6,"It is recommended that you queue it to run after normal business hours.",!
End DoDot:1
+6 ;
+7 IF $GET(IBEXCEL)
DO EXMSG^IBJD
+8 ;
+9 SET %ZIS="QM"
DO ^%ZIS
if POP
GOTO ENQ
+10 IF $DATA(IO("Q"))
Begin DoDot:1
+11 SET ZTRTN="DQ^IBJDF7"
SET ZTDESC="IB - REPAYMENT PLAN REPORT"
+12 SET ZTSAVE("IB*")=""
DO ^%ZTLOAD
+13 IF $GET(ZTSK)
WRITE !!,"This job has been queued. The task no. is ",ZTSK,"."
+14 IF '$TEST
WRITE !!,"Unable to queue this job."
+15 KILL ZTSK,IO("Q")
DO HOME^%ZIS
End DoDot:1
GOTO ENQ
+16 ;
+17 USE IO
+18 ;
DQ ; Change extract status.
IF $GET(IBXTRACT)
DO E^IBJDE(38,1)
+1 ; Compile and print the report.
DO ST^IBJDF71
+2 ;
ENQ KILL DIROUT,DTOUT,DUOUT,DIRUT,I,IBDAYS,IBEXCEL,IBI,IBMCR,IBSN,IBSNF,IBSNL
+1 KILL IBOFF,IBSNA,IBPLN,IBRPT,IBTPT,POP,X,ZTDESC,ZTRTN,ZTSAVE,Y,%ZIS
+2 QUIT
