RCTC394P ;MNTVBB/RGB - Remove TOP date flag that prevented CS billing ; Oct 21, 2021@11:28:14
V ;;4.5;Accounts Receivable;**394**;Mar 20, 1995;Build 6
;;Per VA Directive 6402, this routine should not be modified.
;
;;PRCA*4.5*394 The TOP accounts found should never have been sent to TOP once the Treasury cross-service
;; batch run started with a cutoff date of 08-01-15 (or 02-01-15) for the 3 beta sites.
;; ** THIS PATCH WILL RESET THOSE BILLS THAT HAD MISSING NODE: ^RCD(340,"TOP",IEN)
Q
EN ;TASK TOP FLIP
D BMES^XPDUTL("Tasking the search of TOP accounts that should not have")
D BMES^XPDUTL("been sent to Top after 8-1-15 in a background job.")
N ZTSK,ZTRTN,ZTDESC,ZTIO,ZTDTH,ZTSAVE
S ZTRTN="EN1^RCTC394P",ZTDESC="PRCA*4.5*394 post-init process"
S ZTSAVE("*")="",ZTDTH=$H,ZTIO="" D ^%ZTLOAD
Q
EN1 N RCSITE,RCACTDT,RCDEBTOR,RCBILL
S RCSITE=$E($$SITE^RCMSITE(),1,3),U="^",DT=$$DT^XLFDT
K ^XTMP("RCTC394P")
S ^XTMP("RCTC394P",0)=$$FMADD^XLFDT(DT,90)_"^"_DT
S ^XTMP("RCTC394P",$J,0)="0^0"
N RCDEBTR0,RCDEBTR1,RCDEBTR3,RCDEBTR7,RCDEBTR8,RCDEMCS,RCTOTAL,RCDFN,RCDEMCS,RCDOB,RCGNDR
N RCB0,RCB4,RCB6,RCB7,RCB9,RCB12,RCB121,RCB14,RCB15,RCB16,RCB19,RCB20,RCACTION,RCRR,RCCAT,RCRR,RCCTR
N RCTT,RCTB,RCTB1,RCTD,RCTD1,IEN,CTR,RCIEN
S (RCDEBTOR,RCTB,RCTB1,RCTD,RCTD1)=0
S RCACTDT=3150801 ;activation date for all sites except beckley, little rock, upstate ny
S:RCSITE=598 RCACTDT=3150201 ;activation date for little rock
S:RCSITE=517 RCACTDT=3150201 ;activation date for beckley
S:RCSITE=528 RCACTDT=3150201 ;activation date for upstate ny
RSDEBTOR ;
F S RCDEBTOR=$O(^PRCA(430,"C",RCDEBTOR)) Q:RCDEBTOR'?1N.N D
. D NOW^%DTC S ^XTMP("RCTC394P",$J,"ZZBDEBTOR")=%_U_RCDEBTOR
. I '$D(^RCD(340,"TOP",RCDEBTOR))&'$D(^RCD(340,RCDEBTOR,4)) Q
. Q:$G(^RCD(340,RCDEBTOR,0))'["DPT"
. I '$D(^RCD(340,RCDEBTOR,0)) S ^XTMP("RCTC394P",$J,"ZZUNDEF",RCDEBTOR)="" Q
. S RCDEBTR0=^RCD(340,RCDEBTOR,0),RCDEBTR1=$G(^(1)),RCDEBTR3=$G(^(3)),RCDEBTR7=$G(^(7))
. S RCDEBTR8=$O(^RCD(340,RCDEBTOR,8,"A"),-1) I RCDEBTR8?1.N S RCDEBTR8=$P($G(^RCD(340,RCDEBTOR,8,RCDEBTR8,0)),U)
. S RCDFN=+RCDEBTR0
. S RCDEMCS=$$DEM^RCTCSP1(RCDFN)
. S RCDOB=$P(RCDEMCS,U,2)
. S RCGNDR=$P(RCDEMCS,U,1) S:"MF"'[RCGNDR RCGNDR="U"
. S (RCBILL,RCTOTAL)=0
RSBILL . F S RCBILL=$O(^PRCA(430,"C",RCDEBTOR,RCBILL)) Q:RCBILL'?1N.N D
.. I $G(^PRCA(430,RCBILL,14))<RCACTDT Q
.. D NOW^%DTC S ^XTMP("RCTC394P",$J,"ZZCTRACKER")=%_U_RCDEBTOR_U_RCBILL
.. S RCB0=$G(^PRCA(430,RCBILL,0)),RCB4=$G(^(4)),RCB6=$G(^(6)),RCB7=$G(^(7)),RCB9=$G(^(9)),RCB12=$G(^(12)),RCB121=$G(^(12.1)),RCB14=$G(^(14)),RCB15=$G(^(15)),RCB16=$G(^(16)),RCB19=$G(^(19)),RCB20=$G(^(20))
.. S RCCAT=$P($G(^PRCA(430.2,$P(RCB0,U,2),0)),U,7) Q:'RCCAT
.. Q:'$$RFCHK(RCCAT,"N",1.03,$P(RCB6,U,21))
.. S RCTOTAL=$P(RCB7,U)+$P(RCB7,U,2)+$P(RCB7,U,3)+$P(RCB7,U,4)+$P(RCB7,U,5)
.. I $P(RCB0,U,8)'=16 Q
.. Q:RCB4 ;repayment plan
.. Q:+$P(RCDEMCS,U,4) ;deceased patient
.. Q:'$P(RCB0,U,2) ;no category
.. S RCTD=RCTD+RCTOTAL,RCTB=RCTB+1
.. I RCTOTAL<25 S RCTB1=RCTB1+1,RCTD1=RCTD1+RCTOTAL
.. S ^XTMP("RCTC394P",$J,2,$P(RCB0,U,2))=RCCAT,^XTMP("RCTC394P",$J,3,($P(RCB6,U,21)\1))="",^XTMP("RCTC394P",$J,4,$P(RCB14,U))=""
.. S ^XTMP("RCTC394P",$J,1,RCDEBTOR,RCBILL)=$P(RCB0,U)_U_RCTOTAL_U_RCB14_U_($P(RCB6,U,21)\1)_U_$P(RCB0,U,2)_U_RCCAT
.. K ^PRCA(430,RCBILL,14)
.. Q
S $P(^XTMP("RCTC394P",$J,0),U)=RCTB,$P(^XTMP("RCTC394P",$J,0),U,2)=RCTD
S $P(^XTMP("RCTC394P",$J,0),U,3)=RCTB1,$P(^XTMP("RCTC394P",$J,0),U,4)=RCTD1
D NOW^%DTC S ^XTMP("RCTC394P",$J,"ZZCOMPLETE")=%
MSG N XMY,XMDUZ,XMSUB,XMTEXT,BMSG,IEN,CTR,RCIEN,DIFROM
S XMDUZ=.5
S XMY("G.TCSP")=""
S XMSUB="**** REROUTED DATED TOP BILLS ***"
S BMSG(1)="The following TOP bills have been reversed from TOP as they went after the"
S BMSG(2)="CS cutover control date of "_RCACTDT
S BMSG(3)=" "
S BMSG(4)="REVERSED TOP BILLS TO: "_RCTB_" / "_RCTD_" BILLS <$25: "_RCTB1_" / "_RCTD1
S BMSG(5)=" "
S BMSG(6)=" Bill No. Total Act. Date Top Date Cat./ien"
S BMSG(7)=" =========== ======= ========= ========= ========"
M ^XTMP("RCTC394P",$J,5)=BMSG
S RCDEBTOR=0
S RCCTR=7 F S RCDEBTOR=$O(^XTMP("RCTC394P",$J,1,RCDEBTOR)),RCIEN=0 Q:'RCDEBTOR D
. F S RCIEN=$O(^XTMP("RCTC394P",$J,1,RCDEBTOR,RCIEN)) Q:'RCIEN D
. . S RCRR=^XTMP("RCTC394P",$J,1,RCDEBTOR,RCIEN)
. . S RCCTR=RCCTR+1,^XTMP("RCTC394P",$J,5,RCCTR)=" "_$P(RCRR,U)_$J($P(RCRR,U,2),12,2)_$J($$FMTE^XLFDT($P(RCRR,U,3),"5Z"),15)_$J($$FMTE^XLFDT($P(RCRR,U,4),"5Z"),14)_$J($P(RCRR,U,6)_"/"_$P(RCRR,U,5),9)
S XMTEXT="^XTMP(""RCTC394P"","_$J_",5,"
D ^XMD
MSG2 ;MSG SENT TO TOP GUN
N XMDUZ,XMSUB,XMTEXT,XMY,XMSG,DIFROM
S XMSG("MSG",1)="TOP REVERSAL NUMBERS FOR SITE: "_RCSITE_" PATCH 394 INSTALL:"_$J($$FMTE^XLFDT(DT,"5Z"),10)
S XMSG("MSG",2)=""
S XMSG("MSG",3)="REVERSED TOP BILLS/$$: "_RCTB_" / "_RCTD_" BILLS <$25: "_RCTB1_" / "_RCTD1
S XMSUB="TOP REVERSAL NUMBERS ("_RCSITE_")"
S XMDUZ=.5,XMTEXT="XMSG(""MSG"","
S XMY("NYE.MARI_BETH@V02.DOMAIN.EXT")=""
D ^XMD
EXIT Q
RFCHK(RCXCAT,RCIENFLG,RCXRFCD,RCXDT) ;Check to see if bill can be referred to requested collections program
;
;Input:
; RCXCAT - (Required) AR Category to check.
; RCXIENFLG - Is the AR Category an IEN (I) or a number (N).
; RCXRFCD - (Required) FileMan Field number for the Referral type being checked.
; 1.01 - DMC
; 1.02 - TOP
; 1.03 - CS
; RCXDT - (Required) Date of service to be checked.
;
N RCXFLG,RCXCTIEN,RCXSPDT
;
; Set the initial split date for the TOP and CS referral programs
S RCXSPDT=3150801
; Get the category IEN.
S RCXCTIEN=RCXCAT ;Initially assume it is an IEN
; Update to IEN if AR Category is the Category Number
I RCIENFLG="N" S RCXCTIEN=$O(^PRCA(430.2,"AC",RCXCAT,""))
; Quit if Category not found
Q:RCXCTIEN="" 0
;
; Extract the flag for the category from the AR Category file (430.2), using the field number sent in
S RCXCTIEN=RCXCTIEN_","
S RCXFLG=$$GET1^DIQ(430.2,RCXCTIEN,RCXRFCD,"I")
I RCXFLG<2 Q RCXFLG
I RCXFLG=2,(RCXDT<RCXSPDT) Q 1
I RCXFLG=3,(RCXDT'<RCXSPDT) Q 1
Q 0
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRCTC394P 6230 printed Nov 22, 2024@16:58:51 Page 2
RCTC394P ;MNTVBB/RGB - Remove TOP date flag that prevented CS billing ; Oct 21, 2021@11:28:14
V ;;4.5;Accounts Receivable;**394**;Mar 20, 1995;Build 6
+1 ;;Per VA Directive 6402, this routine should not be modified.
+2 ;
+3 ;;PRCA*4.5*394 The TOP accounts found should never have been sent to TOP once the Treasury cross-service
+4 ;; batch run started with a cutoff date of 08-01-15 (or 02-01-15) for the 3 beta sites.
+5 ;; ** THIS PATCH WILL RESET THOSE BILLS THAT HAD MISSING NODE: ^RCD(340,"TOP",IEN)
+6 QUIT
EN ;TASK TOP FLIP
+1 DO BMES^XPDUTL("Tasking the search of TOP accounts that should not have")
+2 DO BMES^XPDUTL("been sent to Top after 8-1-15 in a background job.")
+3 NEW ZTSK,ZTRTN,ZTDESC,ZTIO,ZTDTH,ZTSAVE
+4 SET ZTRTN="EN1^RCTC394P"
SET ZTDESC="PRCA*4.5*394 post-init process"
+5 SET ZTSAVE("*")=""
SET ZTDTH=$HOROLOG
SET ZTIO=""
DO ^%ZTLOAD
+6 QUIT
EN1 NEW RCSITE,RCACTDT,RCDEBTOR,RCBILL
+1 SET RCSITE=$EXTRACT($$SITE^RCMSITE(),1,3)
SET U="^"
SET DT=$$DT^XLFDT
+2 KILL ^XTMP("RCTC394P")
+3 SET ^XTMP("RCTC394P",0)=$$FMADD^XLFDT(DT,90)_"^"_DT
+4 SET ^XTMP("RCTC394P",$JOB,0)="0^0"
+5 NEW RCDEBTR0,RCDEBTR1,RCDEBTR3,RCDEBTR7,RCDEBTR8,RCDEMCS,RCTOTAL,RCDFN,RCDEMCS,RCDOB,RCGNDR
+6 NEW RCB0,RCB4,RCB6,RCB7,RCB9,RCB12,RCB121,RCB14,RCB15,RCB16,RCB19,RCB20,RCACTION,RCRR,RCCAT,RCRR,RCCTR
+7 NEW RCTT,RCTB,RCTB1,RCTD,RCTD1,IEN,CTR,RCIEN
+8 SET (RCDEBTOR,RCTB,RCTB1,RCTD,RCTD1)=0
+9 ;activation date for all sites except beckley, little rock, upstate ny
SET RCACTDT=3150801
+10 ;activation date for little rock
if RCSITE=598
SET RCACTDT=3150201
+11 ;activation date for beckley
if RCSITE=517
SET RCACTDT=3150201
+12 ;activation date for upstate ny
if RCSITE=528
SET RCACTDT=3150201
RSDEBTOR ;
+1 FOR
SET RCDEBTOR=$ORDER(^PRCA(430,"C",RCDEBTOR))
if RCDEBTOR'?1N.N
QUIT
Begin DoDot:1
+2 DO NOW^%DTC
SET ^XTMP("RCTC394P",$JOB,"ZZBDEBTOR")=%_U_RCDEBTOR
+3 IF '$DATA(^RCD(340,"TOP",RCDEBTOR))&'$DATA(^RCD(340,RCDEBTOR,4))
QUIT
+4 if $GET(^RCD(340,RCDEBTOR,0))'["DPT"
QUIT
+5 IF '$DATA(^RCD(340,RCDEBTOR,0))
SET ^XTMP("RCTC394P",$JOB,"ZZUNDEF",RCDEBTOR)=""
QUIT
+6 SET RCDEBTR0=^RCD(340,RCDEBTOR,0)
SET RCDEBTR1=$GET(^(1))
SET RCDEBTR3=$GET(^(3))
SET RCDEBTR7=$GET(^(7))
+7 SET RCDEBTR8=$ORDER(^RCD(340,RCDEBTOR,8,"A"),-1)
IF RCDEBTR8?1.N
SET RCDEBTR8=$PIECE($GET(^RCD(340,RCDEBTOR,8,RCDEBTR8,0)),U)
+8 SET RCDFN=+RCDEBTR0
+9 SET RCDEMCS=$$DEM^RCTCSP1(RCDFN)
+10 SET RCDOB=$PIECE(RCDEMCS,U,2)
+11 SET RCGNDR=$PIECE(RCDEMCS,U,1)
if "MF"'[RCGNDR
SET RCGNDR="U"
+12 SET (RCBILL,RCTOTAL)=0
RSBILL FOR
SET RCBILL=$ORDER(^PRCA(430,"C",RCDEBTOR,RCBILL))
if RCBILL'?1N.N
QUIT
Begin DoDot:2
+1 IF $GET(^PRCA(430,RCBILL,14))<RCACTDT
QUIT
+2 DO NOW^%DTC
SET ^XTMP("RCTC394P",$JOB,"ZZCTRACKER")=%_U_RCDEBTOR_U_RCBILL
+3 SET RCB0=$GET(^PRCA(430,RCBILL,0))
SET RCB4=$GET(^(4))
SET RCB6=$GET(^(6))
SET RCB7=$GET(^(7))
SET RCB9=$GET(^(9))
SET RCB12=$GET(^(12))
SET RCB121=$GET(^(12.1))
SET RCB14=$GET(^(14))
SET RCB15=$GET(^(15))
SET RCB16=$GET(^(16))
SET RCB19=$GET(^(19))
SET RCB20=$GET(^(20))
+4 SET RCCAT=$PIECE($GET(^PRCA(430.2,$PIECE(RCB0,U,2),0)),U,7)
if 'RCCAT
QUIT
+5 if '$$RFCHK(RCCAT,"N",1.03,$PIECE(RCB6,U,21))
QUIT
+6 SET RCTOTAL=$PIECE(RCB7,U)+$PIECE(RCB7,U,2)+$PIECE(RCB7,U,3)+$PIECE(RCB7,U,4)+$PIECE(RCB7,U,5)
+7 IF $PIECE(RCB0,U,8)'=16
QUIT
+8 ;repayment plan
if RCB4
QUIT
+9 ;deceased patient
if +$PIECE(RCDEMCS,U,4)
QUIT
+10 ;no category
if '$PIECE(RCB0,U,2)
QUIT
+11 SET RCTD=RCTD+RCTOTAL
SET RCTB=RCTB+1
+12 IF RCTOTAL<25
SET RCTB1=RCTB1+1
SET RCTD1=RCTD1+RCTOTAL
+13 SET ^XTMP("RCTC394P",$JOB,2,$PIECE(RCB0,U,2))=RCCAT
SET ^XTMP("RCTC394P",$JOB,3,($PIECE(RCB6,U,21)\1))=""
SET ^XTMP("RCTC394P",$JOB,4,$PIECE(RCB14,U))=""
+14 SET ^XTMP("RCTC394P",$JOB,1,RCDEBTOR,RCBILL)=$PIECE(RCB0,U)_U_RCTOTAL_U_RCB14_U_($PIECE(RCB6,U,21)\1)_U_$PIECE(RCB0,U,2)_U_RCCAT
+15 KILL ^PRCA(430,RCBILL,14)
+16 QUIT
End DoDot:2
End DoDot:1
+17 SET $PIECE(^XTMP("RCTC394P",$JOB,0),U)=RCTB
SET $PIECE(^XTMP("RCTC394P",$JOB,0),U,2)=RCTD
+18 SET $PIECE(^XTMP("RCTC394P",$JOB,0),U,3)=RCTB1
SET $PIECE(^XTMP("RCTC394P",$JOB,0),U,4)=RCTD1
+19 DO NOW^%DTC
SET ^XTMP("RCTC394P",$JOB,"ZZCOMPLETE")=%
MSG NEW XMY,XMDUZ,XMSUB,XMTEXT,BMSG,IEN,CTR,RCIEN,DIFROM
+1 SET XMDUZ=.5
+2 SET XMY("G.TCSP")=""
+3 SET XMSUB="**** REROUTED DATED TOP BILLS ***"
+4 SET BMSG(1)="The following TOP bills have been reversed from TOP as they went after the"
+5 SET BMSG(2)="CS cutover control date of "_RCACTDT
+6 SET BMSG(3)=" "
+7 SET BMSG(4)="REVERSED TOP BILLS TO: "_RCTB_" / "_RCTD_" BILLS <$25: "_RCTB1_" / "_RCTD1
+8 SET BMSG(5)=" "
+9 SET BMSG(6)=" Bill No. Total Act. Date Top Date Cat./ien"
+10 SET BMSG(7)=" =========== ======= ========= ========= ========"
+11 MERGE ^XTMP("RCTC394P",$JOB,5)=BMSG
+12 SET RCDEBTOR=0
+13 SET RCCTR=7
FOR
SET RCDEBTOR=$ORDER(^XTMP("RCTC394P",$JOB,1,RCDEBTOR))
SET RCIEN=0
if 'RCDEBTOR
QUIT
Begin DoDot:1
+14 FOR
SET RCIEN=$ORDER(^XTMP("RCTC394P",$JOB,1,RCDEBTOR,RCIEN))
if 'RCIEN
QUIT
Begin DoDot:2
+15 SET RCRR=^XTMP("RCTC394P",$JOB,1,RCDEBTOR,RCIEN)
+16 SET RCCTR=RCCTR+1
SET ^XTMP("RCTC394P",$JOB,5,RCCTR)=" "_$PIECE(RCRR,U)_$JUSTIFY($PIECE(RCRR,U,2),12,2)_$JUSTIFY($$FMTE^XLFDT($PIECE(RCRR,U,3),"5Z"),15)_$JUSTIFY($$FMTE^XLFDT($PIECE(RCRR,U,4),"5Z"),14)_$JUSTIFY($PIECE(RCRR,U,6)_"/"_$PIECE(RCRR,U,
5),9)
End DoDot:2
End DoDot:1
+17 SET XMTEXT="^XTMP(""RCTC394P"","_$JOB_",5,"
+18 DO ^XMD
MSG2 ;MSG SENT TO TOP GUN
+1 NEW XMDUZ,XMSUB,XMTEXT,XMY,XMSG,DIFROM
+2 SET XMSG("MSG",1)="TOP REVERSAL NUMBERS FOR SITE: "_RCSITE_" PATCH 394 INSTALL:"_$JUSTIFY($$FMTE^XLFDT(DT,"5Z"),10)
+3 SET XMSG("MSG",2)=""
+4 SET XMSG("MSG",3)="REVERSED TOP BILLS/$$: "_RCTB_" / "_RCTD_" BILLS <$25: "_RCTB1_" / "_RCTD1
+5 SET XMSUB="TOP REVERSAL NUMBERS ("_RCSITE_")"
+6 SET XMDUZ=.5
SET XMTEXT="XMSG(""MSG"","
+7 SET XMY("NYE.MARI_BETH@V02.DOMAIN.EXT")=""
+8 DO ^XMD
EXIT QUIT
RFCHK(RCXCAT,RCIENFLG,RCXRFCD,RCXDT) ;Check to see if bill can be referred to requested collections program
+1 ;
+2 ;Input:
+3 ; RCXCAT - (Required) AR Category to check.
+4 ; RCXIENFLG - Is the AR Category an IEN (I) or a number (N).
+5 ; RCXRFCD - (Required) FileMan Field number for the Referral type being checked.
+6 ; 1.01 - DMC
+7 ; 1.02 - TOP
+8 ; 1.03 - CS
+9 ; RCXDT - (Required) Date of service to be checked.
+10 ;
+11 NEW RCXFLG,RCXCTIEN,RCXSPDT
+12 ;
+13 ; Set the initial split date for the TOP and CS referral programs
+14 SET RCXSPDT=3150801
+15 ; Get the category IEN.
+16 ;Initially assume it is an IEN
SET RCXCTIEN=RCXCAT
+17 ; Update to IEN if AR Category is the Category Number
+18 IF RCIENFLG="N"
SET RCXCTIEN=$ORDER(^PRCA(430.2,"AC",RCXCAT,""))
+19 ; Quit if Category not found
+20 if RCXCTIEN=""
QUIT 0
+21 ;
+22 ; Extract the flag for the category from the AR Category file (430.2), using the field number sent in
+23 SET RCXCTIEN=RCXCTIEN_","
+24 SET RCXFLG=$$GET1^DIQ(430.2,RCXCTIEN,RCXRFCD,"I")
+25 IF RCXFLG<2
QUIT RCXFLG
+26 IF RCXFLG=2
IF (RCXDT<RCXSPDT)
QUIT 1
+27 IF RCXFLG=3
IF (RCXDT'<RCXSPDT)
QUIT 1
+28 QUIT 0
