source: WorldVistAEHR/trunk/r/INTEGRATED_BILLING-IB-PRQ--IBD--IBQ--PRQS/IBJDF7.m@ 1036

Last change on this file since 1036 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 2.7 KB
Line 
1IBJDF7 ;ALB/MR - REPAYMENT PLAN REPORT;14-AUG-00
2 ;;2.0;INTEGRATED BILLING;**123**;21-MAR-94
3 ;
4EN ; - 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 ;
14CDPP ; - 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 ;
29MCR ; - 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 ;
50DEV ; - 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 ;
69DQ I $G(IBXTRACT) D E^IBJDE(38,1) ; Change extract status.
70 D ST^IBJDF71 ; Compile and print the report.
71 ;
72ENQ 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
Note: See TracBrowser for help on using the repository browser.