1 | RCRCRR ;ALB/CMS - RC RECONCILIATION DRIVER ; 16-JUN-00
|
---|
2 | V ;;4.5;Accounts Receivable;**61,63,147,159**;Mar 20, 1995
|
---|
3 | ;;Per VHA Directive 10-93-142, this routine should not be modified.
|
---|
4 | Q
|
---|
5 | RRR ;Request Reconciliation Rollup from RC option entry point
|
---|
6 | N DIR,DTOUT,DUOUT,DIRUT,DIROUT,RCBDT,RCCAT,RCDIV,RCDOM,RCEDT,RCI,RCJOB,RCSITE,RCSUB,RCWHO,X,X1,XMDUZ,XMSUB,XMTEXT,XMZ,X,Y
|
---|
7 | W !!!," This option will send a Reconciliation Roll-up mail message request to your"
|
---|
8 | W !," supporting Regional Counsel office. Using this option is not CPU intensive."
|
---|
9 | W !," Four mail messages each containing a different report will be sent"
|
---|
10 | W !," to the RC RC REFERRALS mail group at this site and the RC office"
|
---|
11 | W !," containing the outcome of the referral comparison. The messages may"
|
---|
12 | W !," take up to a day to be delivered since it relies on Mailman delivery"
|
---|
13 | W !," system response time at your Medical Center and your supporting RC office."
|
---|
14 | W !!
|
---|
15 | S DIR("A")="Continue with Request",DIR(0)="Y",DIR("B")="NO" D ^DIR
|
---|
16 | I ($D(DIRUT))!($D(DIROUT)) G RRRQ
|
---|
17 | I Y'=1 G RRRQ
|
---|
18 | ;
|
---|
19 | CAT W !! S RCCAT="RR1"
|
---|
20 | ;W !!,"AR Category to include in Roll-up Request"
|
---|
21 | ;W !,"1. Reimbursable Health",!,"2. Worker's Comp, Tort Feasor and No-Fault Auto."
|
---|
22 | ;R !!,"Select 1 or 2 : 1//",X:DTIME I ('$T)!(X["^") G RRRQ
|
---|
23 | ;I X=2 S RCCAT="RR2" G DT
|
---|
24 | ;I (X="")!(X=1) S RCCAT="RR1" G DT
|
---|
25 | ;W !!,"You must select a Category or enter '^' to exit." G CAT
|
---|
26 | ;
|
---|
27 | DT ; Get date range for Report 4 of 4
|
---|
28 | W !!,"Report (4 of 4) Bills in AR and RC with same Dollar amount HOWEVER,"
|
---|
29 | W !," a Contract/Decrease adjustment was made before the Referral Date."
|
---|
30 | W !!,"This report is for you to review and determine the validity of the adjustment."
|
---|
31 | W !,"Select the Referral Date range for referred bills that have a decrease"
|
---|
32 | W !,"adjustment made prior to the bill referral date."
|
---|
33 | W !!," Adjusted bills or bills with valid decreases will continue to"
|
---|
34 | W !," display in the same selected Referral Date time frame."
|
---|
35 | BDT W ! S %DT="AEPX",%DT(0)=-DT,%DT("A")="Start with Referral Date: " D ^%DT K %DT
|
---|
36 | G RRRQ:Y<0 S RCBDT=Y
|
---|
37 | W ! S %DT="AEPX",%DT(0)=RCBDT,%DT("A")="End with Referral Date: " D ^%DT K %DT
|
---|
38 | G RRRQ:Y<0 S RCEDT=Y
|
---|
39 | ;
|
---|
40 | S RCSITE=$$SITE^RCMSITE
|
---|
41 | D RCDIV^RCRCDIV(.RCDIV)
|
---|
42 | I $O(RCDIV(0)) S RCI=0 F S RCI=$O(RCDIV(RCI)) Q:'RCI D
|
---|
43 | .S RCDOM=$P(RCDIV(RCI),U,6)
|
---|
44 | .D SEND
|
---|
45 | E S RCDOM=$$RCDOM^RCRCUTL D SEND
|
---|
46 | RRRQ Q
|
---|
47 | ;
|
---|
48 | SEND ;Called with user supplied date range
|
---|
49 | S (RCSUB,XMSUB)="AR/RC -"_RCSITE_" Reconciliation Roll-up Request ("_$S(RCCAT="RR1":"RI)",1:"WC,TF,NA)")
|
---|
50 | S X1(1)="$$RC$"_RCCAT_"$$"_RCSITE_"$S.RC RC SERV"
|
---|
51 | S X1(2)="$END$1$"_RCBDT_"$"_RCEDT
|
---|
52 | S XMTEXT="X1("
|
---|
53 | S RCWHO=RCDOM
|
---|
54 | S XMY(RCWHO)="",XMY(DUZ)=""
|
---|
55 | D ^XMD I XMZ<1 W !!,"** Mail message not created. Please Try Again. **" G RRRQ
|
---|
56 | W !!,"Request sent to "_RCDOM_" in Mail Message #("_XMZ_").",!
|
---|
57 | D ENT^RCRCXMS(XMZ,RCSUB,RCWHO)
|
---|
58 | SENDQ Q
|
---|
59 | ;
|
---|
60 | TASK ;Task the RC background job from the RC Server
|
---|
61 | ;Called from RCRCSVR
|
---|
62 | N I,ZTDESC,ZTDTH,ZTIO,ZTRTN,ZTSK,ZTSAVE,%,%I,%H,X,Y
|
---|
63 | I $P($G(RCVAR),U,6)="" G TASKQ
|
---|
64 | D NOW^%DTC S ZTDTH=%
|
---|
65 | S ZTRTN=$P(RCVAR,U,6),ZTDESC=$P(RCVAR,U,4),ZTIO=""
|
---|
66 | F I="RCSITE","RCBDT","RCEDT","RCJOB","RCXTYP","RCVAR","RCXMY","RCXMZ" S ZTSAVE(I)=""
|
---|
67 | D ^%ZTLOAD
|
---|
68 | TASKQ Q
|
---|
69 | ;
|
---|
70 | BKTSK(RCCAT) ;This entry point is called from the scheduled options
|
---|
71 | ;to send a Reconciliation request to RC
|
---|
72 | ;Input: RR1=Reimburs.Health RR2=NON-Reimburs.Health
|
---|
73 | N RCSITE,RCSUB,RCDOM,RCDIV,RCWHO,RCI,X1,XMCHAN,XMDUZ,XMSUB,XMTEXT,XMY,XMZ,X,Y
|
---|
74 | I ($G(RCCAT)'="RR1")&($G(RCCAT)'="RR2") G BKTSKQ
|
---|
75 | ;Line below should be removed when RC is ready to Reconcile Worker's Comp., Torts and No Fault AUTO
|
---|
76 | I $G(RCCAT)="RR2" G BKTSKQ
|
---|
77 | S RCSITE=$$SITE^RCMSITE
|
---|
78 | D RCDIV^RCRCDIV(.RCDIV)
|
---|
79 | I $O(RCDIV(0)) S RCI=0 F S RCI=$O(RCDIV(RCI)) Q:'RCI D
|
---|
80 | .S RCDOM=$P(RCDIV(RCI),U,6)
|
---|
81 | .D BSND
|
---|
82 | E S RCDOM=$$RCDOM^RCRCUTL D BSND
|
---|
83 | D PRG
|
---|
84 | BKTSKQ Q
|
---|
85 | ;
|
---|
86 | BSND ;Send with date values set to T-30
|
---|
87 | S XMCHAN=1
|
---|
88 | BKTA S (RCSUB,XMSUB)="AR/RC -"_RCSITE_" Reconciliation Roll-up Request ("_$S(RCCAT="RR1":"RI)",1:"TF,WC,NA)")
|
---|
89 | S X1(1)="$$RC$"_RCCAT_"$$"_RCSITE_"$S.RC RC SERV"
|
---|
90 | S X1(2)="$END$1$"_$$FMADD^XLFDT(DT,-30)_"$"_DT
|
---|
91 | S XMTEXT="X1("
|
---|
92 | S RCWHO=RCDOM,XMY(RCWHO)="",XMY(DUZ)=""
|
---|
93 | D ^XMD I XMZ<1 G BKTA
|
---|
94 | D ENT^RCRCXMS(XMZ,RCSUB,RCWHO)
|
---|
95 | BSNDQ Q
|
---|
96 | ;
|
---|
97 | PRG ;Purge old entries in the File 349.3
|
---|
98 | N DA,DIK,RCI,X,Y
|
---|
99 | S DIK="^RCT(349.3,"
|
---|
100 | S RCI=0 F S RCI=$O(^RCT(349.3,"AD",RCI)) Q:'RCI D
|
---|
101 | .I RCI>DT Q
|
---|
102 | .S DA=0 F S DA=$O(^RCT(349.3,"AD",RCI,DA)) Q:'DA D ^DIK
|
---|
103 | PRGQ Q
|
---|
104 | ;RCRCRR
|
---|