RCRCRR ;ALB/CMS - RC RECONCILIATION DRIVER ; 16-JUN-00
V ;;4.5;Accounts Receivable;**61,63,147,159**;Mar 20, 1995
;;Per VHA Directive 10-93-142, this routine should not be modified.
Q
RRR ;Request Reconciliation Rollup from RC option entry point
N DIR,DTOUT,DUOUT,DIRUT,DIROUT,RCBDT,RCCAT,RCDIV,RCDOM,RCEDT,RCI,RCJOB,RCSITE,RCSUB,RCWHO,X,X1,XMDUZ,XMSUB,XMTEXT,XMZ,X,Y
W !!!," This option will send a Reconciliation Roll-up mail message request to your"
W !," supporting Regional Counsel office. Using this option is not CPU intensive."
W !," Four mail messages each containing a different report will be sent"
W !," to the RC RC REFERRALS mail group at this site and the RC office"
W !," containing the outcome of the referral comparison. The messages may"
W !," take up to a day to be delivered since it relies on Mailman delivery"
W !," system response time at your Medical Center and your supporting RC office."
W !!
S DIR("A")="Continue with Request",DIR(0)="Y",DIR("B")="NO" D ^DIR
I ($D(DIRUT))!($D(DIROUT)) G RRRQ
I Y'=1 G RRRQ
;
CAT W !! S RCCAT="RR1"
;W !!,"AR Category to include in Roll-up Request"
;W !,"1. Reimbursable Health",!,"2. Worker's Comp, Tort Feasor and No-Fault Auto."
;R !!,"Select 1 or 2 : 1//",X:DTIME I ('$T)!(X["^") G RRRQ
;I X=2 S RCCAT="RR2" G DT
;I (X="")!(X=1) S RCCAT="RR1" G DT
;W !!,"You must select a Category or enter '^' to exit." G CAT
;
DT ; Get date range for Report 4 of 4
W !!,"Report (4 of 4) Bills in AR and RC with same Dollar amount HOWEVER,"
W !," a Contract/Decrease adjustment was made before the Referral Date."
W !!,"This report is for you to review and determine the validity of the adjustment."
W !,"Select the Referral Date range for referred bills that have a decrease"
W !,"adjustment made prior to the bill referral date."
W !!," Adjusted bills or bills with valid decreases will continue to"
W !," display in the same selected Referral Date time frame."
BDT W ! S %DT="AEPX",%DT(0)=-DT,%DT("A")="Start with Referral Date: " D ^%DT K %DT
G RRRQ:Y<0 S RCBDT=Y
W ! S %DT="AEPX",%DT(0)=RCBDT,%DT("A")="End with Referral Date: " D ^%DT K %DT
G RRRQ:Y<0 S RCEDT=Y
;
S RCSITE=$$SITE^RCMSITE
D RCDIV^RCRCDIV(.RCDIV)
I $O(RCDIV(0)) S RCI=0 F S RCI=$O(RCDIV(RCI)) Q:'RCI D
.S RCDOM=$P(RCDIV(RCI),U,6)
.D SEND
E S RCDOM=$$RCDOM^RCRCUTL D SEND
RRRQ Q
;
SEND ;Called with user supplied date range
S (RCSUB,XMSUB)="AR/RC -"_RCSITE_" Reconciliation Roll-up Request ("_$S(RCCAT="RR1":"RI)",1:"WC,TF,NA)")
S X1(1)="$$RC$"_RCCAT_"$$"_RCSITE_"$S.RC RC SERV"
S X1(2)="$END$1$"_RCBDT_"$"_RCEDT
S XMTEXT="X1("
S RCWHO=RCDOM
S XMY(RCWHO)="",XMY(DUZ)=""
D ^XMD I XMZ<1 W !!,"** Mail message not created. Please Try Again. **" G RRRQ
W !!,"Request sent to "_RCDOM_" in Mail Message #("_XMZ_").",!
D ENT^RCRCXMS(XMZ,RCSUB,RCWHO)
SENDQ Q
;
TASK ;Task the RC background job from the RC Server
;Called from RCRCSVR
N I,ZTDESC,ZTDTH,ZTIO,ZTRTN,ZTSK,ZTSAVE,%,%I,%H,X,Y
I $P($G(RCVAR),U,6)="" G TASKQ
D NOW^%DTC S ZTDTH=%
S ZTRTN=$P(RCVAR,U,6),ZTDESC=$P(RCVAR,U,4),ZTIO=""
F I="RCSITE","RCBDT","RCEDT","RCJOB","RCXTYP","RCVAR","RCXMY","RCXMZ" S ZTSAVE(I)=""
D ^%ZTLOAD
TASKQ Q
;
BKTSK(RCCAT) ;This entry point is called from the scheduled options
;to send a Reconciliation request to RC
;Input: RR1=Reimburs.Health RR2=NON-Reimburs.Health
N RCSITE,RCSUB,RCDOM,RCDIV,RCWHO,RCI,X1,XMCHAN,XMDUZ,XMSUB,XMTEXT,XMY,XMZ,X,Y
I ($G(RCCAT)'="RR1")&($G(RCCAT)'="RR2") G BKTSKQ
;Line below should be removed when RC is ready to Reconcile Worker's Comp., Torts and No Fault AUTO
I $G(RCCAT)="RR2" G BKTSKQ
S RCSITE=$$SITE^RCMSITE
D RCDIV^RCRCDIV(.RCDIV)
I $O(RCDIV(0)) S RCI=0 F S RCI=$O(RCDIV(RCI)) Q:'RCI D
.S RCDOM=$P(RCDIV(RCI),U,6)
.D BSND
E S RCDOM=$$RCDOM^RCRCUTL D BSND
D PRG
BKTSKQ Q
;
BSND ;Send with date values set to T-30
S XMCHAN=1
BKTA S (RCSUB,XMSUB)="AR/RC -"_RCSITE_" Reconciliation Roll-up Request ("_$S(RCCAT="RR1":"RI)",1:"TF,WC,NA)")
S X1(1)="$$RC$"_RCCAT_"$$"_RCSITE_"$S.RC RC SERV"
S X1(2)="$END$1$"_$$FMADD^XLFDT(DT,-30)_"$"_DT
S XMTEXT="X1("
S RCWHO=RCDOM,XMY(RCWHO)="",XMY(DUZ)=""
D ^XMD I XMZ<1 G BKTA
D ENT^RCRCXMS(XMZ,RCSUB,RCWHO)
BSNDQ Q
;
PRG ;Purge old entries in the File 349.3
N DA,DIK,RCI,X,Y
S DIK="^RCT(349.3,"
S RCI=0 F S RCI=$O(^RCT(349.3,"AD",RCI)) Q:'RCI D
.I RCI>DT Q
.S DA=0 F S DA=$O(^RCT(349.3,"AD",RCI,DA)) Q:'DA D ^DIK
PRGQ Q
;RCRCRR
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRCRCRR 4511 printed Apr 09, 2024@20:53:47 Page 2
RCRCRR ;ALB/CMS - RC RECONCILIATION DRIVER ; 16-JUN-00
V ;;4.5;Accounts Receivable;**61,63,147,159**;Mar 20, 1995
+1 ;;Per VHA Directive 10-93-142, this routine should not be modified.
+2 QUIT
RRR ;Request Reconciliation Rollup from RC option entry point
+1 NEW DIR,DTOUT,DUOUT,DIRUT,DIROUT,RCBDT,RCCAT,RCDIV,RCDOM,RCEDT,RCI,RCJOB,RCSITE,RCSUB,RCWHO,X,X1,XMDUZ,XMSUB,XMTEXT,XMZ,X,Y
+2 WRITE !!!," This option will send a Reconciliation Roll-up mail message request to your"
+3 WRITE !," supporting Regional Counsel office. Using this option is not CPU intensive."
+4 WRITE !," Four mail messages each containing a different report will be sent"
+5 WRITE !," to the RC RC REFERRALS mail group at this site and the RC office"
+6 WRITE !," containing the outcome of the referral comparison. The messages may"
+7 WRITE !," take up to a day to be delivered since it relies on Mailman delivery"
+8 WRITE !," system response time at your Medical Center and your supporting RC office."
+9 WRITE !!
+10 SET DIR("A")="Continue with Request"
SET DIR(0)="Y"
SET DIR("B")="NO"
DO ^DIR
+11 IF ($DATA(DIRUT))!($DATA(DIROUT))
GOTO RRRQ
+12 IF Y'=1
GOTO RRRQ
+13 ;
CAT WRITE !!
SET RCCAT="RR1"
+1 ;W !!,"AR Category to include in Roll-up Request"
+2 ;W !,"1. Reimbursable Health",!,"2. Worker's Comp, Tort Feasor and No-Fault Auto."
+3 ;R !!,"Select 1 or 2 : 1//",X:DTIME I ('$T)!(X["^") G RRRQ
+4 ;I X=2 S RCCAT="RR2" G DT
+5 ;I (X="")!(X=1) S RCCAT="RR1" G DT
+6 ;W !!,"You must select a Category or enter '^' to exit." G CAT
+7 ;
DT ; Get date range for Report 4 of 4
+1 WRITE !!,"Report (4 of 4) Bills in AR and RC with same Dollar amount HOWEVER,"
+2 WRITE !," a Contract/Decrease adjustment was made before the Referral Date."
+3 WRITE !!,"This report is for you to review and determine the validity of the adjustment."
+4 WRITE !,"Select the Referral Date range for referred bills that have a decrease"
+5 WRITE !,"adjustment made prior to the bill referral date."
+6 WRITE !!," Adjusted bills or bills with valid decreases will continue to"
+7 WRITE !," display in the same selected Referral Date time frame."
BDT WRITE !
SET %DT="AEPX"
SET %DT(0)=-DT
SET %DT("A")="Start with Referral Date: "
DO ^%DT
KILL %DT
+1 if Y<0
GOTO RRRQ
SET RCBDT=Y
+2 WRITE !
SET %DT="AEPX"
SET %DT(0)=RCBDT
SET %DT("A")="End with Referral Date: "
DO ^%DT
KILL %DT
+3 if Y<0
GOTO RRRQ
SET RCEDT=Y
+4 ;
+5 SET RCSITE=$$SITE^RCMSITE
+6 DO RCDIV^RCRCDIV(.RCDIV)
+7 IF $ORDER(RCDIV(0))
SET RCI=0
FOR
SET RCI=$ORDER(RCDIV(RCI))
if 'RCI
QUIT
Begin DoDot:1
+8 SET RCDOM=$PIECE(RCDIV(RCI),U,6)
+9 DO SEND
End DoDot:1
+10 IF '$TEST
SET RCDOM=$$RCDOM^RCRCUTL
DO SEND
RRRQ QUIT
+1 ;
SEND ;Called with user supplied date range
+1 SET (RCSUB,XMSUB)="AR/RC -"_RCSITE_" Reconciliation Roll-up Request ("_$SELECT(RCCAT="RR1":"RI)",1:"WC,TF,NA)")
+2 SET X1(1)="$$RC$"_RCCAT_"$$"_RCSITE_"$S.RC RC SERV"
+3 SET X1(2)="$END$1$"_RCBDT_"$"_RCEDT
+4 SET XMTEXT="X1("
+5 SET RCWHO=RCDOM
+6 SET XMY(RCWHO)=""
SET XMY(DUZ)=""
+7 DO ^XMD
IF XMZ<1
WRITE !!,"** Mail message not created. Please Try Again. **"
GOTO RRRQ
+8 WRITE !!,"Request sent to "_RCDOM_" in Mail Message #("_XMZ_").",!
+9 DO ENT^RCRCXMS(XMZ,RCSUB,RCWHO)
SENDQ QUIT
+1 ;
TASK ;Task the RC background job from the RC Server
+1 ;Called from RCRCSVR
+2 NEW I,ZTDESC,ZTDTH,ZTIO,ZTRTN,ZTSK,ZTSAVE,%,%I,%H,X,Y
+3 IF $PIECE($GET(RCVAR),U,6)=""
GOTO TASKQ
+4 DO NOW^%DTC
SET ZTDTH=%
+5 SET ZTRTN=$PIECE(RCVAR,U,6)
SET ZTDESC=$PIECE(RCVAR,U,4)
SET ZTIO=""
+6 FOR I="RCSITE","RCBDT","RCEDT","RCJOB","RCXTYP","RCVAR","RCXMY","RCXMZ"
SET ZTSAVE(I)=""
+7 DO ^%ZTLOAD
TASKQ QUIT
+1 ;
BKTSK(RCCAT) ;This entry point is called from the scheduled options
+1 ;to send a Reconciliation request to RC
+2 ;Input: RR1=Reimburs.Health RR2=NON-Reimburs.Health
+3 NEW RCSITE,RCSUB,RCDOM,RCDIV,RCWHO,RCI,X1,XMCHAN,XMDUZ,XMSUB,XMTEXT,XMY,XMZ,X,Y
+4 IF ($GET(RCCAT)'="RR1")&($GET(RCCAT)'="RR2")
GOTO BKTSKQ
+5 ;Line below should be removed when RC is ready to Reconcile Worker's Comp., Torts and No Fault AUTO
+6 IF $GET(RCCAT)="RR2"
GOTO BKTSKQ
+7 SET RCSITE=$$SITE^RCMSITE
+8 DO RCDIV^RCRCDIV(.RCDIV)
+9 IF $ORDER(RCDIV(0))
SET RCI=0
FOR
SET RCI=$ORDER(RCDIV(RCI))
if 'RCI
QUIT
Begin DoDot:1
+10 SET RCDOM=$PIECE(RCDIV(RCI),U,6)
+11 DO BSND
End DoDot:1
+12 IF '$TEST
SET RCDOM=$$RCDOM^RCRCUTL
DO BSND
+13 DO PRG
BKTSKQ QUIT
+1 ;
BSND ;Send with date values set to T-30
+1 SET XMCHAN=1
BKTA SET (RCSUB,XMSUB)="AR/RC -"_RCSITE_" Reconciliation Roll-up Request ("_$SELECT(RCCAT="RR1":"RI)",1:"TF,WC,NA)")
+1 SET X1(1)="$$RC$"_RCCAT_"$$"_RCSITE_"$S.RC RC SERV"
+2 SET X1(2)="$END$1$"_$$FMADD^XLFDT(DT,-30)_"$"_DT
+3 SET XMTEXT="X1("
+4 SET RCWHO=RCDOM
SET XMY(RCWHO)=""
SET XMY(DUZ)=""
+5 DO ^XMD
IF XMZ<1
GOTO BKTA
+6 DO ENT^RCRCXMS(XMZ,RCSUB,RCWHO)
BSNDQ QUIT
+1 ;
PRG ;Purge old entries in the File 349.3
+1 NEW DA,DIK,RCI,X,Y
+2 SET DIK="^RCT(349.3,"
+3 SET RCI=0
FOR
SET RCI=$ORDER(^RCT(349.3,"AD",RCI))
if 'RCI
QUIT
Begin DoDot:1
+4 IF RCI>DT
QUIT
+5 SET DA=0
FOR
SET DA=$ORDER(^RCT(349.3,"AD",RCI,DA))
if 'DA
QUIT
DO ^DIK
End DoDot:1
PRGQ QUIT
+1 ;RCRCRR
