source: FOIAVistA/trunk/r/ACCOUNTS_RECEIVABLE-PRCA-PRY-RC/RCRCRR.m@ 1397

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

initial load of FOIAVistA 6/30/08 version

File size: 4.3 KB
Line 
1RCRCRR ;ALB/CMS - RC RECONCILIATION DRIVER ; 16-JUN-00
2V ;;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
5RRR ;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 ;
19CAT 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 ;
27DT ; 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."
35BDT 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
46RRRQ Q
47 ;
48SEND ;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)
58SENDQ Q
59 ;
60TASK ;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
68TASKQ Q
69 ;
70BKTSK(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
84BKTSKQ Q
85 ;
86BSND ;Send with date values set to T-30
87 S XMCHAN=1
88BKTA 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)
95BSNDQ Q
96 ;
97PRG ;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
103PRGQ Q
104 ;RCRCRR
Note: See TracBrowser for help on using the repository browser.