[613] | 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
|
---|