| 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
 | 
|---|