1 | IBJDF7 ;ALB/MR - REPAYMENT PLAN REPORT;14-AUG-00
|
---|
2 | ;;2.0;INTEGRATED BILLING;**123**;21-MAR-94
|
---|
3 | ;
|
---|
4 | EN ; - Option entry point.
|
---|
5 | S (IBEXCEL,IBTPT)=0,IBDAYS=1
|
---|
6 | ;
|
---|
7 | ; - Determine sorting (By name or Last 4 SSN)
|
---|
8 | S IBSN=$$SNL^IBJD() G ENQ:IBSN="^"
|
---|
9 | ;
|
---|
10 | ; - Determine the range
|
---|
11 | S X=$$INTV^IBJD("PATIENT "_$S(IBSN="N":"NAME",1:"LAST 4")) G ENQ:X="^"
|
---|
12 | S IBSNF=$P(X,"^",1),IBSNL=$P(X,"^",2),IBSNA=$P(X,"^",3)
|
---|
13 | ;
|
---|
14 | CDPP ; - Select Current or Defaulted Payment Plan
|
---|
15 | S DIR(0)="SA^C:CURRENT;D:DEFAULTED;B:BOTH"
|
---|
16 | S DIR("A")="Print (C)URRENT, (D)EFAULTED Repayment Plans or (B)OTH: "
|
---|
17 | S DIR("B")="B",DIR("T")=300,DIR("L")=""
|
---|
18 | S (DIR("?"),DIR("??"))="^S IBOFF=23 D HELP^IBJDF7H"
|
---|
19 | W ! D ^DIR K DIR G:$D(DIRUT)!$D(DTOUT)!$D(DUOUT)!$D(DIROUT) ENQ
|
---|
20 | S IBPLN=Y K DIROUT,DTOUT,DUOUT,DIRUT G MCR:IBPLN="C"
|
---|
21 | ;
|
---|
22 | ; - Minimum number of days defaulted
|
---|
23 | S DIR(0)="NA^1:999",DIR("B")=1
|
---|
24 | S DIR("A")="Minimum number of days defaulted: "
|
---|
25 | S DIR("T")=300,DIR("?")="^S IBOFF=32 D HELP^IBJDF7H"
|
---|
26 | W ! D ^DIR K DIR G:$D(DTOUT)!$D(DUOUT)!$D(DIROUT) ENQ
|
---|
27 | S IBDAYS=+Y W:IBDAYS " day(s)" K DIROUT,DTOUT,DUOUT
|
---|
28 | ;
|
---|
29 | MCR ; - Select MCCR or NON-MCCR Receivables
|
---|
30 | S DIR(0)="SA^M:MCCR;N:NON-MCCR"
|
---|
31 | S DIR("A")="Print (M)CCR or (N)ON-MCCR Receivables: "
|
---|
32 | S DIR("B")="M",DIR("T")=300,DIR("L")=""
|
---|
33 | S (DIR("?"),DIR("??"))="^S IBOFF=39 D HELP^IBJDF7H"
|
---|
34 | W ! D ^DIR K DIR G:$D(DIRUT)!$D(DTOUT)!$D(DUOUT)!$D(DIROUT) ENQ
|
---|
35 | S IBMCR=Y K DIROUT,DTOUT,DUOUT,DIRUT
|
---|
36 | ;
|
---|
37 | ; - Select a detailed or summary report.
|
---|
38 | D DS^IBJD G ENQ:IBRPT["^",DEV:IBRPT="S"
|
---|
39 | ;
|
---|
40 | ; - Determine whether to gather data for Excel report.
|
---|
41 | S IBEXCEL=$$EXCEL^IBJD() G ENQ:IBEXCEL="^",DEV:IBEXCEL
|
---|
42 | ;
|
---|
43 | ; - Print TOTAL by Patient?
|
---|
44 | S DIR(0)="Y",DIR("B")="YES",DIR("T")=300 W !
|
---|
45 | S DIR("A")="Do you want to include TOTALs by Patient"
|
---|
46 | S DIR("?")="^S IBOFF=55 D HELP^IBJDF7H"
|
---|
47 | D ^DIR K DIR G:$D(DIRUT)!$D(DTOUT)!$D(DUOUT)!$D(DIROUT) ENQ
|
---|
48 | S IBTPT=+Y K DIROUT,DTOUT,DUOUT,DIRUT
|
---|
49 | ;
|
---|
50 | DEV ; - Select a device.
|
---|
51 | W !!,"This report requires a ",$S(IBRPT="S":80,1:132)," column printer."
|
---|
52 | ;
|
---|
53 | I '$G(IBEXCEL) D
|
---|
54 | . W !!,"Note: This report will search through all active receivables."
|
---|
55 | . W !?6,"It is recommended that you queue it to run after normal business hours.",!
|
---|
56 | ;
|
---|
57 | I $G(IBEXCEL) D EXMSG^IBJD
|
---|
58 | ;
|
---|
59 | S %ZIS="QM" D ^%ZIS G:POP ENQ
|
---|
60 | I $D(IO("Q")) D G ENQ
|
---|
61 | .S ZTRTN="DQ^IBJDF7",ZTDESC="IB - REPAYMENT PLAN REPORT"
|
---|
62 | .S ZTSAVE("IB*")="" D ^%ZTLOAD
|
---|
63 | .I $G(ZTSK) W !!,"This job has been queued. The task no. is ",ZTSK,"."
|
---|
64 | .E W !!,"Unable to queue this job."
|
---|
65 | .K ZTSK,IO("Q") D HOME^%ZIS
|
---|
66 | ;
|
---|
67 | U IO
|
---|
68 | ;
|
---|
69 | DQ I $G(IBXTRACT) D E^IBJDE(38,1) ; Change extract status.
|
---|
70 | D ST^IBJDF71 ; Compile and print the report.
|
---|
71 | ;
|
---|
72 | ENQ K DIROUT,DTOUT,DUOUT,DIRUT,I,IBDAYS,IBEXCEL,IBI,IBMCR,IBSN,IBSNF,IBSNL
|
---|
73 | K IBOFF,IBSNA,IBPLN,IBRPT,IBTPT,POP,X,ZTDESC,ZTRTN,ZTSAVE,Y,%ZIS
|
---|
74 | Q
|
---|