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

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

initial load of WorldVistAEHR
File size: 4.1 KB
RevLine 
[613]1IBOTR1 ;ALB/CPM - INSURANCE PAYMENT TREND REPORT - USER INTERFACE ; 5-JUN-91
2 ;;2.0;INTEGRATED BILLING;**21,42,72,100,118,128**;21-MAR-94
3 ;
4 ;MAP TO DGCROTR1
5 ;
6OUTPT W !!,"Select (I)NPATIENT, (O)UTPATIENT, or (B)OTH bill records: BOTH// "
7 R X:DTIME G:'$T!(X["^") END S:X="" X="B" S X=$E(X)
8 I "BIObio"'[X S IBOFF=1 D HELP^IBOTR11 G OUTPT
9 W " ",$S("Ii"[X:"INPATIENT","Oo"[X:"OUTPATIENT",1:"BOTH")
10 S (IBBRT,IBBRTY)=$S("Ii"[X:"I","Oo"[X:"O",1:"A") I "Bb"'[X G ARST
11 ;
12REPTY W !,"Print (C)OMBINED or (S)EPARATE reports: COMBINED// "
13 R X:DTIME G:'$T!(X["^") END S:X="" X="C" S X=$E(X)
14 I "CScs"'[X S IBOFF=7 D HELP^IBOTR11 G REPTY
15 W " ",$S("Cc"[X:"COMBINED",1:"SEPARATE")
16 S IBBRN=$S("Cc"[X:"C",1:"S")
17 ;
18ARST W !,"Select (O)PEN, (C)LOSED, or (B)OTH types of bills: BOTH// "
19 R X:DTIME G:'$T!(X["^") END S:X="" X="B" S X=$E(X)
20 I "BCObco"'[X S IBOFF=14 D HELP^IBOTR11 G ARST
21 W " ",$S("Oo"[X:"OPEN","Cc"[X:"CLOSED",1:"BOTH")
22 S IBARST=$S("Oo"[X:"O","Cc"[X:"C",1:"A")
23 ;
24CANC I $G(IBAF)=16 G QDATE ; Skip if CANCEL BILL? field was selected.
25 S DIR(0)="Y",DIR("B")="NO"
26 S DIR("A")="Do you want to include cancelled bills"
27 S DIR("?")="^S IBOFF=20 D HELP^IBOTR11"
28 D ^DIR K DIR S IBCANC=+Y I $D(DIRUT)!$D(DTOUT)!$D(DUOUT) G END
29 ;
30QDATE S DIR(0)="SA^1:DATE BILL PRINTED;2:TREATMENT DATE"
31 S DIR("A")="Print report by 1-DATE BILL PRINTED or 2-TREATMENT DATE: "
32 S DIR("B")="1",DIR("T")=20,DIR("?")="^S IBOFF=25 D HELP^IBOTR11"
33 W ! D ^DIR K DIR G:Y=""!(X="^") END S IBDF=Y,IBDFN=Y(0)
34BEGDT S %DT="AEPX",%DT("A")=" Start with "_IBDFN_": "
35 D ^%DT K %DT G:Y<0 END S IBBDT=Y
36 S %DT="AEPX",%DT("A")=" Go to "_IBDFN_": "
37 D ^%DT K %DT G:Y<0 END S IBEDT=Y
38 I Y<IBBDT W *7,!!?3,"The END DATE must follow the BEGIN DATE.",! G BEGDT
39 ;
40PRINT W !!,"Print (M)AIN REPORT, (S)UMMARY, or (G)RAND TOTALS: M// "
41 R X:DTIME G:'$T!(X["^") END S:X="" X="M" S X=$E(X)
42 I "GMSgms"'[X S IBOFF=30 D HELP^IBOTR11 G PRINT
43 W " ",$S("Mm"[X:"MAIN REPORT","Ss"[X:"SUMMARY",1:"GRAND TOTALS")
44 S IBPRNT=$S("Mm"[X:"M","Ss"[X:"S",1:"G")
45 ;
46INS W !,"Run ",$S("MS"[IBPRNT:"report",1:"totals")
47 W " for (S)PECIFIC insurance companies or a (R)ANGE: RANGE// "
48 R X:DTIME G:'$T!(X["^") END S:X="" X="R" S X=$E(X)
49 I "RSrs"'[X S IBOFF=38 D HELP^IBOTR11 G INS
50 W " ",$S("Ss"[X:"SPECIFIC",1:"RANGE") G:"Rr"[X INSO1 K IBICPT
51INSO S DIC="^DIC(36,",DIC(0)="AEQMZ",DIC("S")="I '$G(^(5))"
52 S DIC("A")=" Select "_$S($G(IBICPT):"another ",1:"")_"INSURANCE CO.: "
53 D ^DIC K DIC I Y'>0 G END:'$G(IBICPT),INSO3
54 I $D(IBICPT(+Y)) D G INSO
55 .W !!?3,"Already selected. Choose another insurance company.",!,*7
56 S IBICPT(+Y)="",IBICPT=$G(IBICPT)+1 G INSO
57INSO1 W !?3,"Start with INSURANCE COMPANY: FIRST// " R X:DTIME
58 G:'$T!(X["^") END I $E(X)="?" S IBOFF=43 D HELP^IBOTR11 G INSO1
59 S IBICF=X
60INSO2 W !?8,"Go to INSURANCE COMPANY: LAST// " R X:DTIME
61 G:'$T!(X["^") END I $E(X)="?" S IBOFF=49 D HELP^IBOTR11 G INSO2
62 I X="" S IBICL="zzzzz" S:IBICF="" IBIC="ALL" G INSO3
63 I X="@",IBICF="@" S IBICL="@",IBIC="NULL" G INSO3
64 I IBICF'="@",IBICF]X D G INSO2
65 .W *7,!!?3,"The LAST value must follow the FIRST.",!
66 S IBICL=X
67INSO3 I IBPRNT="G" S IBSORT="I" S:$G(IBICPT)!($G(IBIC)'="ALL") IBG=1 G EXRC
68 I $G(IBICPT)=1 S IBSORT="I" G EXRC
69 W !,"Sort by AMOUNT (O)WED, AMOUNT (P)AID, or (I)NSURANCE CO.: I// "
70 R X:DTIME G:'$T!(X["^") END S:X="" X="I" S X=$E(X)
71 I "IOPiop"'[X S IBOFF=56 D HELP^IBOTR11 G INSO3
72 W " ",$S("Oo"[X:"AMOUNT OWED","Pp"[X:"AMOUNT PAID",1:"INSURANCE CO.")
73 S IBSORT=$S("Oo"[X:"O","Pp"[X:"P",1:"I")
74 ;
75EXRC S DIR(0)="Y",DIR("B")="NO"
76 S DIR("A")="Do you want to include receivables referred to Reg. Counsel"
77 S DIR("?")="^S IBOFF=66 D HELP^IBOTR11"
78 W ! D ^DIR K DIR S IBINRC=+Y I $D(DIRUT)!$D(DTOUT)!$D(DUOUT) G END
79 ;
80DEV W !!,"You will need a 132 column printer for this report!"
81 S %ZIS="QM" D ^%ZIS G:POP END
82 I $D(IO("Q")) D G END
83 .S ZTRTN="^IBOTR2",ZTDESC="INSURANCE PAYMENT TREND REPORT"
84 .F X="IB*","VAUTD","VAUTD(" S ZTSAVE(X)=""
85 .D ^%ZTLOAD W !!,$S($D(ZTSK):"This job has been queued. The task number is "_ZTSK_".",1:"Unable to queue this job.")
86 .K ZTSK,IO("Q") D HOME^%ZIS
87 U IO
88 ;***
89 ;I $D(XRT0) S:'$D(XRTN) XRTN="IBOTR1" D T1^%ZOSV ;stop rt clock
90 D ^IBOTR2 ; Compile and print report.
91 ;
92END K DIRUT,DTOUT,DUOUT,DIROUT
93 Q
Note: See TracBrowser for help on using the repository browser.