source: WorldVistAEHR/trunk/r/ACCOUNTS_RECEIVABLE-PRCA-PRY-RC/RCRCALB.m@ 1714

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

initial load of WorldVistAEHR
File size: 4.3 KB
RevLine 
[613]1RCRCALB ;ALB/CMS - RC FOLLOW-UP ACTION 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 RCRCAL
6 ; Returns: RCSBN,RCSBN(CNT,PRCABN)
7 ; or: RCCAT(catname),RCSI(dbt#),RCSPT,RCSIA,RCSIF,RCSIL,RCSAGN,RCSAGX,RCSAMT,RCSRC,RCDIV(0),RCDIV(40.8#IEN)
8 ; or: RCOUT
9 N CNT,DA,DIC,PRCA,PRCABN,RCLQ,RCLQA,RCY,TCNT,T,X,Y
10 N RCCNT,RCDIV,RCSD,RCRN,RCSN,RCSNF,RCLCNT,RCSNL,RCSNA,RCSAR,RCSH
11 N DIR,DIROUT,DTOUT,DUOUT,DIRUT
12 K RCSBN,RCCAT,RCDIV,RCSI,RCSIF,RCSIL,RCSAGN,RCSAGX,RCSAMT,RCSPT,RCSRC,RCOUT
13 ;
14 ;Get Divisions
15 D RCDIV^RCRCDIV(.RCDIV)
16 ;Select one division if multiple
17 I $O(RCDIV(0)) D DIVS^RCRCDIV I $G(RCOUT)=1 G ENQ
18 ;
19 W !!,"Build List of Third Party RC Referrals"
20 W !!!
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 Range"
25 S DIR("A",5)="4. EOB Processing"
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;4:EOB Processing"
29 S DIR("B")=1
30 D ^DIR
31 I $D(DIRUT)!$D(DTOUT)!$D(DUOUT)!$D(DIROUT) S RCOUT=1 G ENQ
32 I $E(Y)="^" S RCOUT=1 G ENQ
33 S RCRN=Y
34 K DIR,DIROUT,DTOUT,DUOUT,DIRUT
35 ;
36 I RCRN=1 D BILL G ENQ
37 I RCRN=2 D PT I '$G(RCOUT) D ASK
38 I RCRN=3 D INS I '$G(RCOUT) D ASK
39 I RCRN=4 D EN^RCRCBL S RCOUT=1
40ENQ W !
41 I $G(RCOUT)=1 K RCSBN,RCCAT,RCDIV,RCSI,RCSIA,RCSIF,RCSIL,RCSAGN,RCSAGX,RCSPT,RCSAMT,RCSRC
42 K DIR,DIROUT,DTOUT,DUOUT,DIRUT
43 Q
44 ;
45 ;
46BILL ; - issue prompt for AR Bill Selection(s)
47 ; - also called from Modify List Protocol
48 N CNT,DIC,DA,RCI,RC1,X,Y,%Y W !
49 S DIC("A")="Select Active TP Accounts Receivable Bill No.: "
50 S DIC="^PRCA(430,",DIC(0)="AQEMZ"
51 S DIC("S")="I $P(^(0),U,8)=16,$P($G(^PRCA(430.2,+$P(^(0),U,2),0)),U,6)=""T"""
52 S CNT=0 F D Q:($G(PRCABN)<0)!($G(RCOUT))
53 .D ^DIC S PRCABN=Y
54 .I $G(PRCABN)<0 Q
55 .I $G(PRCABN)="^" S RCOUT=1 Q
56 .I +$G(RCDIV(0)),'$$DIV^RCRCDIV(PRCABN) W !!," <<Bill not in selected division.>>",! Q
57 .S CNT=CNT+1,RCSBN=CNT
58 .S RCSBN(+PRCABN)=CNT
59 .S DIC("A")="Select another Active TP Accounts Receivable Bill No.: "
60 .QUIT
61 I '$O(RCSBN(0)) S RCOUT=1
62 K PRCABN,DIC,DA,X,Y,%Y
63BILLQ Q
64 ;
65PT ; - Issue prompt for Patients
66 N DIC,X,Y
67 I $O(RCSPT(0)) S DIC("A")="Select another PATIENT: "
68 S DIC="^DPT(",DIC(0)="QMEAZ"
69 W ! D ^DIC K DIC I $E(Y)="^" S RCOUT=1 G PTQ
70 I Y<0,'$O(RCSPT(0)) S RCOUT=1
71 I Y<0 G PTQ
72 S RCSPT(+Y)=Y G PT
73PTQ Q
74 ;
75INS ; - determine range of carriers
76 R !!,"Build List for (S)elected Third Party Debtor(s) or a (R)ange: Range// ",X:DTIME
77 I ('$T)!(X["^") S RCOUT=1 G INSQ
78 S:X="" X="R" S X=$E(X)
79 I "SRsr"'[X W !!,?15,"Enter 'S' or 'R' or '^' to exit." G INS
80 W $S("sS"[X:" Selected",1:" Range") S RCSI=X
81 I "Rr"[RCSI G INS1
82 ;
83 S DIC("A")="Select THIRD PARTY AR DEBTOR: "
84INSA S DIC="^RCD(340,",DIC(0)="QEAZ",DIC("S")="I $P(^(0),U,1)[""DIC(36,"""
85 W ! D ^DIC K DIC I $E(Y)="^" S RCOUT=1 G INSQ
86 I Y<0,$O(RCSI(0)) G INSQ
87 I Y<0,'$O(RCSI(0)) G INS
88 S RCSI(+Y)=Y
89 S DIC("A")="Select another THIRD PARTY AR DEBTOR: "
90 G INSA
91 ;
92INS1 W !!!," START WITH DEBTOR: FIRST// " R X:DTIME
93 I ('$T)!(X["^") S RCOUT=1 G INSQ
94 I $E(X)="?" W !,?5,"Enter the name of the Insurance Company to start with." G INS1
95 S RCSIF=X
96INS2 W !," GO TO DEBTOR: LAST// " R X:DTIME
97 I ('$T)!(X["^") S RCOUT=1 G INSQ
98 I $E(X)="?" W !,?5,"Enter the name of the Insurance Company to end with." G INS2
99 I X="" S RCSIL="zzzzz" S:RCSIF="" RCSIA="ALL" G INSQ
100 I X="@",RCSIF="@" S RCSIL="@",RCSIA="NULL" G INSQ
101 I RCSIF'="@",RCSIF]X W *7,!!," The LAST value must follow the FIRST.",! G INS1
102 S RCSIL=X
103INSQ Q
104 ;
105ASK ;Ask optional questions
106 ;
107 ; - Build list for Selected Categories
108 N CNT,I,RCCAT,X,Y
109 S RCCAT="" D RCCAT^RCRCUTL(.RCCAT)
110 S (CNT,X)=0 K DIR
111 F S X=$O(RCCAT(X)) Q:'X D
112 .S CNT=CNT+1 S DIR("A",CNT)=CNT_" "_$P(RCCAT(X),U,2)
113 S TCNT=CNT,CNT=CNT+1,DIR("A",CNT)=" "
114 S CNT=CNT+1,DIR("A",CNT)=" "
115 S CNT=CNT+1,DIR("A",CNT)=" "
116 S DIR("A")=" Enter response: "
117 W !!,"AR Categories to Include in Build List"
118 W !," Select from the following:",!
119 S DIR(0)="L^1:"_TCNT
120 D ^DIR I $E(Y)="^" S RCOUT=1 G ASKQ
121 K RCCAT F I=1:1:TCNT I $P(Y,",",I) S RCCAT($P(DIR("A",$P(Y,",",I))," ",2))=""
122 I $D(DIRUT)!$D(DTOUT)!$D(DUOUT)!$D(DIROUT) G ASKQ
123 K DIR,DIROUT,DTOUT,DUOUT,DIRUT
124 ;
125ASKQ Q
126 ;RCRCALB
Note: See TracBrowser for help on using the repository browser.