RCRCREC ;ALB/CMS - RC AND DHCP RECONCILIATION REPORTS ; 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.
;
;Tasked from the RC RC SERV routine
; INPUT: RCJOB,RCSITE,RCVAR,RCXTYP,RCXMY,RCBDT,RCEDT,RCXMZ
;OUTPUT: Four mail messages to G.RC RC REFERRALS
;
N OUT,RCDIV,RCDOMNM
D RCDIV^RCRCDIV(.RCDIV)
;
; - if only one RC division of care, run process and quit
I '$O(RCDIV(0)) D EN G MAINQ
;
; - build new array by the RC domain and division, i.e.
; rcdiv("rcdomain",rc domain name,division)=""
I $O(RCDIV(0)) S RCDIV=0 F S RCDIV=$O(RCDIV(RCDIV)) Q:'RCDIV D
.S RCDIV("RCDOMAIN",$P(RCDIV(RCDIV),"^",2),RCDIV)=""
;
; - run process for each RC domain/office
S RCDOMNM="" F S RCDOMNM=$O(RCDIV("RCDOMAIN",RCDOMNM)) Q:RCDOMNM="" D EN
;
MAINQ I '$D(OUT) K ^XTMP(RCXTYP,RCXMZ)
K RCJOB,RCSITE,RCVAR,RCXTYP,RCXMY,RCXMZ
Q
;
;
EN ; Process bills for each specific RC Office
D INIT
D ^RCRCREC2
D SEND ; Create the four messages and send them to RCXMY
K ^TMP("PRCA",$J)
Q
;
;
INIT ;Initialize variables and arrays
N I,LN,MTYP,RCREG
K ^TMP("PRCA",$J)
S RCSITE=$$SITE^RCMSITE
;
; - set RC reference name for message
S RCREG=$S($G(RCDOMNM)]"":RCDOMNM,1:"REGIONAL COUNSEL SYSTEM")
;
F I=1:1:4 D
.S ^TMP("PRCA",$J,"MR"_I,0)=5
.S ^TMP("PRCA",$J,"MR"_I,3)=" VAMC: "_RCSITE_" - "_$P($G(^DIC(4,RCSITE,0)),U,1)
.S ^TMP("PRCA",$J,"MR"_I,4)=" "
.S ^TMP("PRCA",$J,"MR"_I,5)="============================================================================="
S ^TMP("PRCA",$J,"MR1",1)=" BILLS ACTIVE/REFERRED IN ACCOUNTS RECEIVABLE SYSTEM"
S ^TMP("PRCA",$J,"MR1",2)=" BUT NOT PENDING IN "_RCREG
S ^TMP("PRCA",$J,"MR2",1)=" BILLS PENDING IN "_RCREG
S ^TMP("PRCA",$J,"MR2",2)=" BUT NOT ACTIVE/REFERRED IN ACCOUNTS RECEIVABLE SYSTEM"
S ^TMP("PRCA",$J,"MR3",1)=" BILLS IN REGIONAL COUNSEL SYSTEM AND ACCOUNTS RECEIVABLE SYSTEM"
S ^TMP("PRCA",$J,"MR3",2)=" WITH DIFFERENT DOLLAR AMOUNTS OR PATIENT SSN NUMBER"
S ^TMP("PRCA",$J,"MR4",1)=" BILLS IN REGIONAL COUNSEL SYSTEM AND ACCOUNTS RECEIVABLE SYSTEM"
S ^TMP("PRCA",$J,"MR4",2)=" WITH A DECREASE ADJUSTMENT BEFORE BILL REF.DT "
I RCEDT,RCBDT D
.S Y=RCBDT D D^DIQ
.S ^TMP("PRCA",$J,"MR4",2)=^TMP("PRCA",$J,"MR4",2)_" ("_Y_" to "
.S Y=RCEDT D D^DIQ
.S ^TMP("PRCA",$J,"MR4",2)=^TMP("PRCA",$J,"MR4",2)_Y_")"
;
INITQ Q
;
SEND ;Send reports to Mailman
;Loop for MR1 to MR4
N MREP
F MREP="MR1","MR2","MR3","MR4" D ;
.N LN S MTYP=$E(MREP,3)
.I +$G(^TMP("PRCA",$J,MREP,0))=5 D Q
..S ^TMP("PRCA",$J,MREP,6)=" NO RECORDS FOUND"
..M LN=^TMP("PRCA",$J,MREP) D XMB
.D SBIG Q
SENDQ Q
;
SBIG ;Send the four large reports in a mail message to site and RC
N DATA,II,LN,RETRY,XMCHAN,XMDUZ,XMSUB,XMY,XMZ S RETRY=0
S XMCHAN=1,XMSUB="AR/RC - SITE: "_$G(RCSITE,"UNK")_" ("_+MTYP_" of 4) RECONCILIATION REPORT"
S (XMDUN,XMDUZ)="ACCOUNTS RECEIVABLE RC SERVER"
D XMZ^XMA2 I XMZ<1 S RETRY=RETRY+1 I RETRY<100 G SBIG
I RETRY>99 D D XMB S OUT=1 G SBIGQ
.S MTYP=0
.S LN(1)=" The AR/RC Reconciliation Report is having trouble creating"
.S LN(2)="the four mail messages. Please contact an IRM support person."
S II=0,LN=0 F S II=$O(^TMP("PRCA",$J,MREP,II)) Q:'II D
.S DATA=^TMP("PRCA",$J,MREP,II)
.I $L(DATA) S LN=LN+1 S ^XMB(3.9,XMZ,2,LN,0)=DATA
I $D(^XMB(3.9,XMZ,2)) S ^XMB(3.9,XMZ,2,0)="^3.92^"_LN_U_LN_U_DT
S XMY("G.RC RC REFERRALS")=""
I $G(RCXMY)]"" S XMY(RCXMY)=""
D ENT1^XMD I XMZ<1 S RETRY=RETRY+1 I RETRY<100 G XMB
SBIGQ Q
;
XMB ;Call to mailman
;INPUT: LN( for message text array
; MTYP for message type (1 of 4) or 0 for (1 of 1)
; RCSITE
N RETRY,XMCHAN,XMDUZ,XMSUB,XMTEXT,XMY,XMZ S RETRY=0
S XMCHAN=1,XMSUB="AR/RC - SITE: "_$G(RCSITE,"UNK")_" ("_$S(MTYP=0:1,1:+MTYP)_" of "_$S(MTYP=0:1,1:4)_") RECONCILIATION REPORT"
S XMTEXT="LN(",XMDUZ="ACCOUNTS RECEIVABLE RC SERVER"
S XMY("G.RC RC REFERRALS")=""
I $G(RCXMY)]"" S XMY(RCXMY)=""
D ^XMD I XMZ<1 S RETRY=RETRY+1 I RETRY<100 G XMB
XMBQ Q
;RCRCREC
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRCRCREC 4142 printed Sep 15, 2024@21:11:56 Page 2
RCRCREC ;ALB/CMS - RC AND DHCP RECONCILIATION REPORTS ; 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 ;
+3 ;Tasked from the RC RC SERV routine
+4 ; INPUT: RCJOB,RCSITE,RCVAR,RCXTYP,RCXMY,RCBDT,RCEDT,RCXMZ
+5 ;OUTPUT: Four mail messages to G.RC RC REFERRALS
+6 ;
+7 NEW OUT,RCDIV,RCDOMNM
+8 DO RCDIV^RCRCDIV(.RCDIV)
+9 ;
+10 ; - if only one RC division of care, run process and quit
+11 IF '$ORDER(RCDIV(0))
DO EN
GOTO MAINQ
+12 ;
+13 ; - build new array by the RC domain and division, i.e.
+14 ; rcdiv("rcdomain",rc domain name,division)=""
+15 IF $ORDER(RCDIV(0))
SET RCDIV=0
FOR
SET RCDIV=$ORDER(RCDIV(RCDIV))
if 'RCDIV
QUIT
Begin DoDot:1
+16 SET RCDIV("RCDOMAIN",$PIECE(RCDIV(RCDIV),"^",2),RCDIV)=""
End DoDot:1
+17 ;
+18 ; - run process for each RC domain/office
+19 SET RCDOMNM=""
FOR
SET RCDOMNM=$ORDER(RCDIV("RCDOMAIN",RCDOMNM))
if RCDOMNM=""
QUIT
DO EN
+20 ;
MAINQ IF '$DATA(OUT)
KILL ^XTMP(RCXTYP,RCXMZ)
+1 KILL RCJOB,RCSITE,RCVAR,RCXTYP,RCXMY,RCXMZ
+2 QUIT
+3 ;
+4 ;
EN ; Process bills for each specific RC Office
+1 DO INIT
+2 DO ^RCRCREC2
+3 ; Create the four messages and send them to RCXMY
DO SEND
+4 KILL ^TMP("PRCA",$JOB)
+5 QUIT
+6 ;
+7 ;
INIT ;Initialize variables and arrays
+1 NEW I,LN,MTYP,RCREG
+2 KILL ^TMP("PRCA",$JOB)
+3 SET RCSITE=$$SITE^RCMSITE
+4 ;
+5 ; - set RC reference name for message
+6 SET RCREG=$SELECT($GET(RCDOMNM)]"":RCDOMNM,1:"REGIONAL COUNSEL SYSTEM")
+7 ;
+8 FOR I=1:1:4
Begin DoDot:1
+9 SET ^TMP("PRCA",$JOB,"MR"_I,0)=5
+10 SET ^TMP("PRCA",$JOB,"MR"_I,3)=" VAMC: "_RCSITE_" - "_$PIECE($GET(^DIC(4,RCSITE,0)),U,1)
+11 SET ^TMP("PRCA",$JOB,"MR"_I,4)=" "
+12 SET ^TMP("PRCA",$JOB,"MR"_I,5)="============================================================================="
End DoDot:1
+13 SET ^TMP("PRCA",$JOB,"MR1",1)=" BILLS ACTIVE/REFERRED IN ACCOUNTS RECEIVABLE SYSTEM"
+14 SET ^TMP("PRCA",$JOB,"MR1",2)=" BUT NOT PENDING IN "_RCREG
+15 SET ^TMP("PRCA",$JOB,"MR2",1)=" BILLS PENDING IN "_RCREG
+16 SET ^TMP("PRCA",$JOB,"MR2",2)=" BUT NOT ACTIVE/REFERRED IN ACCOUNTS RECEIVABLE SYSTEM"
+17 SET ^TMP("PRCA",$JOB,"MR3",1)=" BILLS IN REGIONAL COUNSEL SYSTEM AND ACCOUNTS RECEIVABLE SYSTEM"
+18 SET ^TMP("PRCA",$JOB,"MR3",2)=" WITH DIFFERENT DOLLAR AMOUNTS OR PATIENT SSN NUMBER"
+19 SET ^TMP("PRCA",$JOB,"MR4",1)=" BILLS IN REGIONAL COUNSEL SYSTEM AND ACCOUNTS RECEIVABLE SYSTEM"
+20 SET ^TMP("PRCA",$JOB,"MR4",2)=" WITH A DECREASE ADJUSTMENT BEFORE BILL REF.DT "
+21 IF RCEDT
IF RCBDT
Begin DoDot:1
+22 SET Y=RCBDT
DO D^DIQ
+23 SET ^TMP("PRCA",$JOB,"MR4",2)=^TMP("PRCA",$JOB,"MR4",2)_" ("_Y_" to "
+24 SET Y=RCEDT
DO D^DIQ
+25 SET ^TMP("PRCA",$JOB,"MR4",2)=^TMP("PRCA",$JOB,"MR4",2)_Y_")"
End DoDot:1
+26 ;
INITQ QUIT
+1 ;
SEND ;Send reports to Mailman
+1 ;Loop for MR1 to MR4
+2 NEW MREP
+3 ;
FOR MREP="MR1","MR2","MR3","MR4"
Begin DoDot:1
+4 NEW LN
SET MTYP=$EXTRACT(MREP,3)
+5 IF +$GET(^TMP("PRCA",$JOB,MREP,0))=5
Begin DoDot:2
+6 SET ^TMP("PRCA",$JOB,MREP,6)=" NO RECORDS FOUND"
+7 MERGE LN=^TMP("PRCA",$JOB,MREP)
DO XMB
End DoDot:2
QUIT
+8 DO SBIG
QUIT
End DoDot:1
SENDQ QUIT
+1 ;
SBIG ;Send the four large reports in a mail message to site and RC
+1 NEW DATA,II,LN,RETRY,XMCHAN,XMDUZ,XMSUB,XMY,XMZ
SET RETRY=0
+2 SET XMCHAN=1
SET XMSUB="AR/RC - SITE: "_$GET(RCSITE,"UNK")_" ("_+MTYP_" of 4) RECONCILIATION REPORT"
+3 SET (XMDUN,XMDUZ)="ACCOUNTS RECEIVABLE RC SERVER"
+4 DO XMZ^XMA2
IF XMZ<1
SET RETRY=RETRY+1
IF RETRY<100
GOTO SBIG
+5 IF RETRY>99
Begin DoDot:1
+6 SET MTYP=0
+7 SET LN(1)=" The AR/RC Reconciliation Report is having trouble creating"
+8 SET LN(2)="the four mail messages. Please contact an IRM support person."
End DoDot:1
DO XMB
SET OUT=1
GOTO SBIGQ
+9 SET II=0
SET LN=0
FOR
SET II=$ORDER(^TMP("PRCA",$JOB,MREP,II))
if 'II
QUIT
Begin DoDot:1
+10 SET DATA=^TMP("PRCA",$JOB,MREP,II)
+11 IF $LENGTH(DATA)
SET LN=LN+1
SET ^XMB(3.9,XMZ,2,LN,0)=DATA
End DoDot:1
+12 IF $DATA(^XMB(3.9,XMZ,2))
SET ^XMB(3.9,XMZ,2,0)="^3.92^"_LN_U_LN_U_DT
+13 SET XMY("G.RC RC REFERRALS")=""
+14 IF $GET(RCXMY)]""
SET XMY(RCXMY)=""
+15 DO ENT1^XMD
IF XMZ<1
SET RETRY=RETRY+1
IF RETRY<100
GOTO XMB
SBIGQ QUIT
+1 ;
XMB ;Call to mailman
+1 ;INPUT: LN( for message text array
+2 ; MTYP for message type (1 of 4) or 0 for (1 of 1)
+3 ; RCSITE
+4 NEW RETRY,XMCHAN,XMDUZ,XMSUB,XMTEXT,XMY,XMZ
SET RETRY=0
+5 SET XMCHAN=1
SET XMSUB="AR/RC - SITE: "_$GET(RCSITE,"UNK")_" ("_$SELECT(MTYP=0:1,1:+MTYP)_" of "_$SELECT(MTYP=0:1,1:4)_") RECONCILIATION REPORT"
+6 SET XMTEXT="LN("
SET XMDUZ="ACCOUNTS RECEIVABLE RC SERVER"
+7 SET XMY("G.RC RC REFERRALS")=""
+8 IF $GET(RCXMY)]""
SET XMY(RCXMY)=""
+9 DO ^XMD
IF XMZ<1
SET RETRY=RETRY+1
IF RETRY<100
GOTO XMB
XMBQ QUIT
+1 ;RCRCREC
