source: WorldVistAEHR/trunk/r/ACCOUNTS_RECEIVABLE-PRCA-PRY-RC/RCRCVLB.m@ 1150

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

initial load of WorldVistAEHR

File size: 5.8 KB
Line 
1RCRCVLB ;ALB/CMS - RC VIEW ACTIVE LIST BUILD ; 09-AUG-97
2V ;;4.5;Accounts Receivable;**63,159**;Mar 20, 1995
3 ;;Per VHA Directive 10-93-142, this routine should not be modified.
4 Q
5EN ; entry point from RCRCVL
6 ; Returns: RCSBN,RCSBN(CNT,PRCABN)
7 ; or: RCCAT(catname),RCSI(dbt#),RCSPT,RCSIA,RCSIF,RCSIL,RCSAGN,RCSAGX,RCSAMT,RCSRC
8 ; or: if muti-divisions RCDIV(0),RCDIV(selected 40.8IEN)
9 ; or: RCOUT
10 N CNT,DA,DIC,PRCA,PRCABN,RCLQ,RCLQA,RCY,RCS,TCNT,T,X,Y
11 N RCDIV,RCCNT,RCSD,RCRN,RCSN,RCSNF,RCLCNT,RCSNL,RCSNA,RCSAR,RCSH
12 N DIR,DIROUT,DTOUT,DUOUT,DIRUT
13 K RCSBN,RCCAT,RCSI,RCSIF,RCSIL,RCSAGN,RCSAGX,RCSAMT,RCSPT,RCSRC,RCOUT
14 ;
15 ;Get Divisions
16 D RCDIV^RCRCDIV(.RCDIV)
17 ;Select one division if multiple
18 I $O(RCDIV(0)) D DIVS^RCRCDIV I $G(RCOUT)=1 G ENQ
19 ;
20 W !!,"Build List of Possible Third Party Referrals"
21 S DIR("A",1)="Build a list by"
22 S DIR("A",2)="1. Selected AR Third Party Bill(s)"
23 S DIR("A",3)="2. Selected Patient(s)"
24 S DIR("A",4)="3. Selected AR Insurance Debtor(s) or"
25 S DIR("A",5)=" Insurance Range"
26 S DIR("A",6)=" "
27 S DIR("A")=" Select Number: "
28 S DIR(0)="SAXB^1:Third Party Bills;2:Patients;3:Insurance Debtors"
29 S DIR("B")=1
30 D ^DIR I $D(DIRUT)!$D(DTOUT)!$D(DUOUT)!$D(DIROUT) S RCOUT=1 G ENQ
31 I $E(Y)="^" S RCOUT=1 G ENQ
32 S RCRN=Y
33 K DIR,DIROUT,DTOUT,DUOUT,DIRUT
34 ;
35 I RCRN=1 D BILL G ENQ
36 I RCRN=2 D PT I '$G(RCOUT) D ASK
37 I RCRN=3 D INS I '$G(RCOUT) D ASK
38ENQ W !
39 I $G(RCOUT)=1 K RCSBN,RCCAT,RCDIV,RCSI,RCSIA,RCSIF,RCSIL,RCSAGN,RCSAGX,RCSPT,RCSAMT,RCSRC
40 K DIR,DIROUT,DTOUT,DUOUT,DIRUT
41 Q
42 ;
43 ;
44BILL ; - issue prompt for AR Bill Selection(s)
45 ; - also called from Modify List Protocol
46 K DIC,DA,X,Y,%Y W !
47 S DIC("A")="Select Active TP Accounts Receivable Bill No.: "
48 S DIC="^PRCA(430,",DIC(0)="AQMEZ"
49 S DIC("S")="I $P(^(0),U,8)=16,$P($G(^PRCA(430.2,+$P(^(0),U,2),0)),U,6)=""T"""
50 S CNT=0 F D Q:($G(PRCABN)<0)!($G(RCOUT))
51 .D ^DIC S PRCABN=Y
52 .I $G(PRCABN)<0 Q
53 .I $G(PRCABN)="^" S RCOUT=1 Q
54 .I +$G(RCDIV(0)),'$$DIV^RCRCDIV(PRCABN) W !," <<Bill is not in selected division.>>",!
55 .S CNT=CNT+1,RCSBN=CNT
56 .S RCSBN(+PRCABN)=CNT
57 .S DIC("A")="Select another Active TP Accounts Receivable Bill No.: "
58 .QUIT
59 I '$O(RCSBN(0)) S RCOUT=1
60 K PRCABN,DIC,DA,X,Y,%Y
61BILLQ Q
62 ;
63PT ; - Issue prompt for Patients
64 N DIC,X,Y
65 I $O(RCSPT(0)) S DIC("A")="Select another PATIENT: "
66 S DIC="^DPT(",DIC(0)="QMEAZ"
67 W ! D ^DIC K DIC I $E(Y)="^" S RCOUT=1 G PTQ
68 I Y<0,'$O(RCSPT(0)) S RCOUT=1
69 I Y<0 G PTQ
70 S RCSPT(+Y)=Y G PT
71PTQ Q
72 ;
73INS ; - determine range of carriers
74 R !!,"Build List for (S)elected Third Party Debtor(s) or a (R)ange: Range// ",X:DTIME
75 I ('$T)!(X["^") S RCOUT=1 G INSQ
76 S:X="" X="R" S X=$E(X)
77 I "SRsr"'[X W !!,?15,"Enter 'S' or 'R' or '^' to exit." G INS
78 W $S("sS"[X:" Selected",1:" Range") S RCSI=X
79 I "Rr"[RCSI G INS1
80 ;
81 S DIC("A")="Select THIRD PARTY AR DEBTOR: "
82INSA S DIC="^RCD(340,",DIC(0)="QEAZ",DIC("S")="I $P(^(0),U,1)[""DIC(36,"""
83 W ! D ^DIC K DIC I $E(Y)="^" S RCOUT=1 G INSQ
84 I Y<0,$O(RCSI(0)) G INSQ
85 I Y<0,'$O(RCSI(0)) G INS
86 S RCSI(+Y)=Y
87 S DIC("A")="Select another THIRD PARTY AR DEBTOR: "
88 G INSA
89 ;
90INS1 W !!!," START WITH DEBTOR: FIRST// " R X:DTIME
91 I ('$T)!(X["^") S RCOUT=1 G INSQ
92 I $E(X)="?" W !,?5,"Enter the name of the Insurance Company to start with." G INS1
93 S RCSIF=X
94INS2 W !," GO TO DEBTOR: LAST// " R X:DTIME
95 I ('$T)!(X["^") S RCOUT=1 G INSQ
96 I $E(X)="?" W !,?5,"Enter the name of the Insurance Company to end with." G INS2
97 I X="" S RCSIL="zzzzz" S:RCSIF="" RCSIA="ALL" G INSQ
98 I X="@",RCSIF="@" S RCSIL="@",RCSIA="NULL" G INSQ
99 I RCSIF'="@",RCSIF]X W *7,!!," The LAST value must follow the FIRST.",! G INS1
100 S RCSIL=X
101INSQ Q
102 ;
103ASK ;Ask optional questions
104 ;
105 ; - Build list for Selected Categories
106 S RCCAT="" D RCCAT^RCRCUTL(.RCCAT)
107 S (CNT,X)=0 K DIR
108 F S X=$O(RCCAT(X)) Q:'X D
109 .S CNT=CNT+1 S DIR("A",CNT)=CNT_" "_$P(RCCAT(X),U,2)
110 S TCNT=CNT,CNT=CNT+1,DIR("A",CNT)=" "
111 S CNT=CNT+1,DIR("A",CNT)=" *Only Reimburs.Health Bills can be electronically referred at this time."
112 S CNT=CNT+1,DIR("A",CNT)=" "
113 S DIR("A")=" Enter response"
114 W !!,"AR Categories to Include in Build List"
115 W !," Select from the following:",!
116 S DIR(0)="L^1:"_TCNT
117 D ^DIR I $E(Y)="^" S RCOUT=1 G ASKQ
118 K RCCAT F I=1:1:TCNT I $P(Y,",",I) S RCCAT($P(DIR("A",$P(Y,",",I))," ",2))=""
119 I $D(DIRUT)!$D(DTOUT)!$D(DUOUT)!$D(DIROUT) G ASKQ
120 K DIR,DIROUT,DTOUT,DUOUT,DIRUT
121 ;
122AGE ; - determine the active receivable min age
123 S DIR(0)="NOA^1:99999",DIR("?")="Enter a number between (1-99999) or press return"
124 S DIR("A")=" (Optional) Enter the minimum age of the receivables: "
125 W !! D ^DIR S RCSAGN=+Y I $D(DTOUT)!$D(DUOUT)!$D(DIROUT) S RCOUT=1 G ASKQ
126 W:+RCSAGN !," -Bill age over ",RCSAGN," days."
127 K DIR,DIROUT,DTOUT,DUOUT,DIRUT
128 ;
129 ; - determine the active receivable max age
130 S DIR(0)="NOA^1:99999",DIR("?")="Enter a number between (1-99999) or press return"
131 S DIR("A")=" (Optional) Enter the maximum age of the receivables: "
132 W !! D ^DIR S RCSAGX=+Y I $D(DTOUT)!$D(DUOUT)!$D(DIROUT) S RCOUT=1 G ASKQ
133 W:+RCSAGX !," -Bill age under ",RCSAGX," days."
134 K DIR,DIROUT,DTOUT,DUOUT,DIRUT
135 ;
136 I $G(RCSAGX),+$G(RCSAGN)>+$G(RCSAGX) W !!,"Minimum age should be less than the Max. age.",!! G AGE
137 ;
138 ; - determine the active receivable minimum Amount
139 S DIR(0)="NOA^1:99999:2",DIR("?")="Enter a number between (1-99999) or press return"
140 S DIR("A")=" (Optional) Enter the minimum amount of the receivables: "
141 W !! D ^DIR S RCSAMT=+Y I $D(DTOUT)!$D(DUOUT)!$D(DIROUT) S RCOUT=1 G ASKQ
142 W:RCSAMT !," -Current Balance Over $",RCSAMT
143 K DIR,DIROUT,DTOUT,DUOUT,DIRUT
144 ;
145 ; - exclude receivables currently referred to Regional Counsel?
146 S DIR(0)="Y",DIR("B")="Yes"
147 S DIR("?")="Include receivables with a Referral Date in List"
148 S DIR("A")="Include currently referred receivables"
149 W !! D ^DIR S RCSRC=+Y
150 I $D(DIRUT)!$D(DTOUT)!$D(DUOUT)!$D(DIROUT) S RCOUT=1 G ASKQ
151 K DIR,DIROUT,DTOUT,DUOUT,DIRUT
152 ;
153ASKQ Q
154 ;
155 ;RCRCVLB
Note: See TracBrowser for help on using the repository browser.