- PRCABJ ;WASH-ISC@ALTOONA,PA/LDB,TJK - NIGHTLY PROCESS FOR ACCOUNTS RECEIVABLE ;11/8/96 3:54 PM
- ;;4.5;Accounts Receivable;**11,34,101,114,155,153,141,165,167,173,201,237,304,301,378,400**;Mar 20, 1995;Build 13
- ;Per VA Directive 6402, this routine should not be modified.
- ;
- ;This routine is called by the PRCA NIGHTLY PROCESS option which should be run nightly to call the following tasks
- ;1) Update of interest/admin charges on patients' accounts
- ;2) Update statement days
- ;3) Print of Patient Statements, Uniform Billing forms, and non-patient follow-up letters
- ;4) Purge of Receipts
- ;5) Creation of TOP (Treasury Offset Program) documents
- ;6) Creation of Cross-Servicing (Treasury Cross-Servicing Project) documents
- ;7) Print of the Follow-up list
- ;8) Purge AR Events
- ;9) Flag prepayments for refund review
- ;10) Print Comment List
- ;11) Starts the Repayment Plan Monitor
- ;12) Generates Diagnostic Measures Workload Reports
- ;13) Matches EFT with ERA
- ;14) Generates CBO Data Extract files for Boston ARC
- ;15) Auto-audit of Paper Bills
- ;16) Generate the AR Diagnostic Measures Statistical Reports (for a defined period)
- ;17) Auto Updates Repayment Plans
- ;18) Clean out older AR Metrics data.
- ;
- ;Process will first check and Validate AR pointer files 341.1,
- ;430.2, and 430.3.
- ;Process will terminate and send bulletin if files are not valid
- ;
- EN ;Start of nightly process-check to see if process is already running
- L +^RC("PRCABJ"):5 Q:'$T
- NEW ERROR S ERROR=0
- D VERIFY I ERROR L -^RC("PRCABJ") Q
- ;
- DRIVER ;All processes are called from this point
- N CHK,POP,% S CHK=0
- D CHK,RECALL,CHK,INT,CHK,RPP,CHK,EN^RCCPCBJ,CHK,STM,CHK,RECPT,CHK,TOP,CHK,TCSP,CHK,EVNT,CHK,BNUM ; PRCA*4.5*400
- D CHK,ENUM,CHK,PURFMS,CHK,EN3^RCFMOBR,CHK,START^RCRJR,CHK,UB
- D CHK,STATMNT,CHK,UDLIST^PRCABJ1,CHK,LIST,CHK,COMMENT ; PRCA*4.5*400 removed call to REPAY tag
- D CHK,WRKLD,CHK,EFT,CHK,CBO,CHK,ABAUDIT,CHK,ARDM,CHK,CLNMTR
- D NOW^%DTC S $P(^RC(342,1,0),"^",10)=%
- L -^RC("PRCABJ")
- K ^RC("PRCABJ")
- Q
- ;
- CHK ;checkpoint of process
- S CHK=CHK+1 S ^RC("PRCABJ")=CHK
- Q
- ;
- VERIFY ;Verifies Pointer Files--Will HALT Process if Pointer Files Invalid
- NEW A,B,FILE
- F FILE=341.1,430.2,430.3 D Q:ERROR
- .S A=$S(FILE=341.1:"AC;0;2",FILE=430.2:"AC;0;7",1:"AC;0;3")
- .S B=$S(FILE=341.1:"",1:"C;0;2")
- .D EN1^PRCABJV(FILE,A,B,.ERROR)
- .Q:'ERROR
- .;SEND BULLETIN HERE IF FILE IN ERROR
- .NEW XMB,XMTEXT,XMDUZ
- .S XMDUZ="ACCOUNTS RECEIVABLE PACKAGE"
- .S XMB="PRCA NIGHTLY PROCESS ABORT"
- .S XMTEXT="ERROR("
- .D ^XMB
- .Q
- Q
- ;
- INT ; update interest and admin charges for non-benefit debts
- ; example: vendor, employee, ex-employee
- D NONBENE^RCBECHGS
- Q
- ;
- STM ;Update statement days for PERSONS, VENDORS, and Institutions
- D STM^PRCABJ1
- Q
- ;
- STATMNT ;Print patient statements
- N IOP,ZTIO,ZTSAVE,ZTRTN,ZTDESC,ZTASK,%ZIS,ZTDTH,PRCADEV
- S (IOP,PRCADEV)=$P($G(^RC(342,1,0)),"^",8)
- I IOP]"" D
- .S ZTRTN="PRCAGS",ZTDTH=$H,ZTDESC="Print AR Statements/Letters"
- .S %ZIS="N0" D ^%ZIS Q:POP
- .S ZTSAVE("PRCADEV")="" D ^%ZTLOAD,^%ZISC
- Q
- ;
- RECPT ;Manage Receipts and Deposits
- N IOP,ZTIO,ZTSAVE,ZTRTN,ZTDESC,ZTASK,%ZIS,ZTDTH
- S ZTIO="",ZTRTN="MAN^RCDPUT",ZTDTH=$H,ZTDESC="Manage Receipts and Deposits"
- D ^%ZTLOAD
- Q
- ;
- TOP ;Transmit TOP documents
- Q:$$DOW^XLFDT(DT,1)'=1
- I DT'<$P($G(^RC(342,1,30)),"^",1)&(DT'>$P($G(^RC(342,1,30)),"^",2)) D ^RCEXINAD
- N RCM,RCDOC
- ;Run of TOP documents every Monday
- I +$E(DT,6,7)>7,$E(DT,6,7)<15 S RCM=1
- I '$D(^RCD(340,"TOP")),'$G(RCM) Q
- S RCDOC=$S($G(RCM):"M",1:"U")
- I $E(DT,4,5)=12,RCDOC="M" S RCDOC="Y"
- TOPQUE N ZTDESC,ZTASK,ZTDTH,ZTIO,ZTRTN,ARDUZ,ZTSAVE
- S ZTIO="",ZTRTN="^RCTOPD",ZTSAVE("RCDOC")=""
- S ZTDESC="TOP REFERRAL DOCUMENTS",ZTDTH=$H
- D ^%ZTLOAD
- Q
- ;
- TCSP ;Transmit Cross-Servicing (Treasury Cross-Servicing Project) documents
- Q:$$DOW^XLFDT(DT,1)'=2
- ;Run TCSP documents every Tuesday
- TCSPQUE N ZTDESC,ZTASK,ZTDTH,ZTIO,ZTRTN
- S ZTIO="",ZTRTN="^RCTCSPD"
- S ZTDESC="CROSS-SERVICING REFERRAL DOCUMENTS",ZTDTH=$H
- D ^%ZTLOAD
- Q
- ;
- UB ;Print Uniform Billing forms
- N IOP,ZTIO,ZTSAVE,ZTRTN,ZTDESC,ZTASK,%ZIS,ZTDTH
- S ZTIO="",ZTRTN="PRCALT2",ZTDTH=$H,ZTDESC="Print Reimbursable Health Insurance Uniform Billing forms"
- D ^%ZTLOAD,^%ZISC
- Q
- ;
- LIST ;Print Follow-up List
- N IOP,ZTIO,ZTSAVE,ZTRTN,ZTDESC,ZTASK,%ZIS,ZTDTH,BEG,END,PRCADEV
- S IOP=$P($G(^RC(342,1,0)),"^",8)
- I IOP]"" D
- .S %ZIS="N0" D ^%ZIS Q:POP
- .S ZTRTN="DQ1^PRCACM",ZTDTH=$H,PRCADEV=ION_";"_IOST_";"_IOM_";"_IOSL_";"_$G(IO("DOC"))
- .S (ZTSAVE("BEG"),ZTSAVE("END"))=DT,ZTSAVE("PRCADEV")="",ZTDESC="Bill Comment Follow-Up List"
- .D ^%ZTLOAD,^%ZISC
- Q
- ;
- N IOP,ZTIO,ZTSAVE,ZTRTN,ZTDESC,ZTASK,%ZIS,ZTDTH,BEG,END,PRCADEV
- S IOP=$P($G(^RC(342,1,0)),"^",8)
- I IOP]"" D
- .S %ZIS="N0" D ^%ZIS Q:POP
- .S ZTRTN="DQ2^PRCACM",ZTDTH=$H,PRCADEV=ION_";"_IOST_";"_IOM_";"_IOSL_";"_$G(IO("DOC"))
- .S (ZTSAVE("BEG"),ZTSAVE("END"))=DT,ZTSAVE("PRCADEV")="",ZTDESC="Debtor Comment Follow-up List"
- .D ^%ZTLOAD,^%ZISC
- Q
- ;
- WRKLD ; Generates Diagnostic Measures Workload Reports
- N ZTDESC,ZTDTH,ZTIO,ZTRTN,ZTSAVE
- S ZTIO="",ZTRTN="DQ^RCDMBWLR",ZTDTH=$H,ZTDESC="Diagnostic Measures Workload Reports"
- D ^%ZTLOAD
- Q
- ;
- ;PRCA*4.5*304 new tag ARDM
- ARDM ; Generate AR Diagnostic Measures statistic reports weekly
- N ZTDESC,ZTDTH,ZTIO,ZTRTN,ZTSAVE
- ;
- ; run the report
- S ZTIO="",ZTRTN="AUTO^RCDPENRU",ZTDTH=$H,ZTDESC="AR Diagnostic Measures Statistical Reports"
- D ^%ZTLOAD
- Q
- ;
- EVNT ;Purge AR Events
- N IOP,ZTIO,ZTDESC,ZTASK,ZTIO,ZTRTN,ZTSAVE,%ZIS
- S ZTIO="",ZTRTN="PUR^RCEVDRV1",ZTDTH=$H,ZTDESC="Purge AR Event Information" D ^%ZTLOAD
- Q
- PURFMS ;Purge FMS documents
- NEW ZTRTN,ZTIO,ZTDTH,ZTSK,ZTDESC
- S ZTIO="",ZTRTN="EN^RCFMPUR",ZTDESC="AR/FMS DOC PURGE",ZTDTH=$H D ^%ZTLOAD
- Q
- ;
- EFT ; Starts matching of EFTs to EOBs job
- NEW ZTRTN,ZTIO,ZTDTH,ZTSK,ZTDESC
- S ZTIO="",ZTRTN="EN^RCDPEM",ZTDESC="AR/EDI LOCKBOX MATCHING EFTs",ZTDTH=$H D ^%ZTLOAD
- Q
- ;
- BNUM ;Check bill numbering series
- I $P(^RC(342,1,0),"^",3)="" S $P(^RC(342,1,0),"^",3)="K"_$E($$FY^RCFN01,2)_"00000"
- I $E($P(^RC(342,1,0),"^",3),2)'=$E($$FY^RCFN01,2) S $P(^RC(342,1,0),"^",3)="K"_$E($$FY^RCFN01,2)_"00000"
- Q
- ENUM ;Check event numbering series
- I $P(^RC(342,1,0),"^",6)="" S $P(^RC(342,1,0),"^",6)="K"_$E($$FY^RCFN01,2)_"A0000"
- I $E($P(^RC(342,1,0),"^",6),2)'=$E($$FY^RCFN01,2) S $P(^RC(342,1,0),"^",6)="K"_$E($$FY^RCFN01,2)_"A0000"
- Q
- ;
- CBO ; Create Extract Files for ARC
- NEW ZTRTN,ZTIO,ZTDTH,ZTSK,ZTDESC
- S ZTIO="",ZTRTN="EN^RCXVTSK",ZTDESC="CBO DATA EXTRACT",ZTDTH=$H
- D ^%ZTLOAD
- Q
- ;
- ABAUDIT ;PRCA*4.5*304 - Auto-audit Paper bills
- ;
- N ZTRTN,ZTIO,ZTDTH,ZTSK,ZTDESC
- ;
- S ZTIO="",ZTRTN="ABAUDIT^PRCABJ2",ZTDESC="AR AUTO-AUDIT OF PAPER BILLS",ZTDTH=$H D ^%ZTLOAD
- Q
- ;
- RPP ;PRCA*4.5*378 - Repayment Plan Nightly Process
- ;
- N ZTRTN,ZTIO,ZTDTH,ZTSK,ZTDESC
- ;
- S ZTIO="",ZTRTN="MAIN^RCRPNP",ZTDESC="AR REPAYMENT PLAN NIGHTLY PROCESS",ZTDTH=$H D ^%ZTLOAD
- Q
- ;
- CLNMTR ;PRCA*4.5*378 - Remove AR Metrics file data older than the # days specified by the METRICS RETENTION DAYS parameter
- ;
- N ZTRTN,ZTIO,ZTDTH,ZTSK,ZTDESC
- ;
- S ZTIO="",ZTRTN="CLEANUP^RCSTATU",ZTDESC="AR METRICS File (#340.7) data cleanup",ZTDTH=$H D ^%ZTLOAD
- Q
- ;
- RECALL ; if HRFS patient flag is set or date of death is set, then recall CS bills, stop TOP referrals, and remove debtors from DMC PRCA*4.5*400
- N HRFSFLG,RCBILL,RCDB,RCDFN,Z
- ; CS bills
- S RCBILL=0 F S RCBILL=$O(^PRCA(430,"TCSP",RCBILL)) Q:'RCBILL D
- .S RCDB=$P($G(^PRCA(430,RCBILL,0)),U,9) Q:RCDB'>0
- .I +$P($G(^PRCA(430,RCBILL,15)),U,2) Q ; recall has already been set for this bill
- .S Z=$P(^RCD(340,RCDB,0),U) I $P(Z,";",2)'="DPT(" Q
- .S RCDFN=$P(Z,";"),HRFSFLG=$$CHKHRFS^RCHRFSUT(RCDFN,DT)
- .I HRFSFLG=1 S Z=$$RECALL^RCTCSPU(RCBILL)
- .Q
- ; TOP referrals
- S RCDB=0 F S RCDB=$O(^RCD(340,"TOP",RCDB)) Q:'RCDB D
- .S Z=$P(^RCD(340,RCDB,0),U) I $P(Z,";",2)'="DPT(" Q
- .I +$P($G(^RCD(340,RCDB,6)),U,2) Q ; stop TOP referral flag has been set already
- .S RCDFN=$P(Z,";"),HRFSFLG=$$CHKHRFS^RCHRFSUT(RCDFN,DT)
- .I HRFSFLG=1 S Z=$$STOPREF^RCTOPU(RCDB,"O","High Risk flag is set for this debtor",DT) D HRFSCMNT^RCEVGEN(RCDB)
- .Q
- ; cancel DMC
- S RCDB=0 F S RCDB=$O(^RCD(340,"DMC",1,RCDB)) Q:'RCDB D
- .S Z=$P(^RCD(340,RCDB,0),U) I $P(Z,";",2)'="DPT(" Q
- .I +$P($G(^RCD(340,RCDB,3)),U,10) Q ; DMC deletion flag has been set already
- .S RCDFN=$P(Z,";"),HRFSFLG=$$CHKHRFS^RCHRFSUT(RCDFN,DT)
- .I HRFSFLG=1 S Z=$$CANCDMC^RCDMC90U(RCDB) D HRFSCMNT^RCEVGEN(RCDB)
- .Q
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRCABJ 8640 printed Jan 18, 2025@02:40:17 Page 2
- PRCABJ ;WASH-ISC@ALTOONA,PA/LDB,TJK - NIGHTLY PROCESS FOR ACCOUNTS RECEIVABLE ;11/8/96 3:54 PM
- +1 ;;4.5;Accounts Receivable;**11,34,101,114,155,153,141,165,167,173,201,237,304,301,378,400**;Mar 20, 1995;Build 13
- +2 ;Per VA Directive 6402, this routine should not be modified.
- +3 ;
- +4 ;This routine is called by the PRCA NIGHTLY PROCESS option which should be run nightly to call the following tasks
- +5 ;1) Update of interest/admin charges on patients' accounts
- +6 ;2) Update statement days
- +7 ;3) Print of Patient Statements, Uniform Billing forms, and non-patient follow-up letters
- +8 ;4) Purge of Receipts
- +9 ;5) Creation of TOP (Treasury Offset Program) documents
- +10 ;6) Creation of Cross-Servicing (Treasury Cross-Servicing Project) documents
- +11 ;7) Print of the Follow-up list
- +12 ;8) Purge AR Events
- +13 ;9) Flag prepayments for refund review
- +14 ;10) Print Comment List
- +15 ;11) Starts the Repayment Plan Monitor
- +16 ;12) Generates Diagnostic Measures Workload Reports
- +17 ;13) Matches EFT with ERA
- +18 ;14) Generates CBO Data Extract files for Boston ARC
- +19 ;15) Auto-audit of Paper Bills
- +20 ;16) Generate the AR Diagnostic Measures Statistical Reports (for a defined period)
- +21 ;17) Auto Updates Repayment Plans
- +22 ;18) Clean out older AR Metrics data.
- +23 ;
- +24 ;Process will first check and Validate AR pointer files 341.1,
- +25 ;430.2, and 430.3.
- +26 ;Process will terminate and send bulletin if files are not valid
- +27 ;
- EN ;Start of nightly process-check to see if process is already running
- +1 LOCK +^RC("PRCABJ"):5
- if '$TEST
- QUIT
- +2 NEW ERROR
- SET ERROR=0
- +3 DO VERIFY
- IF ERROR
- LOCK -^RC("PRCABJ")
- QUIT
- +4 ;
- DRIVER ;All processes are called from this point
- +1 NEW CHK,POP,%
- SET CHK=0
- +2 ; PRCA*4.5*400
- DO CHK
- DO RECALL
- DO CHK
- DO INT
- DO CHK
- DO RPP
- DO CHK
- DO EN^RCCPCBJ
- DO CHK
- DO STM
- DO CHK
- DO RECPT
- DO CHK
- DO TOP
- DO CHK
- DO TCSP
- DO CHK
- DO EVNT
- DO CHK
- DO BNUM
- +3 DO CHK
- DO ENUM
- DO CHK
- DO PURFMS
- DO CHK
- DO EN3^RCFMOBR
- DO CHK
- DO START^RCRJR
- DO CHK
- DO UB
- +4 ; PRCA*4.5*400 removed call to REPAY tag
- DO CHK
- DO STATMNT
- DO CHK
- DO UDLIST^PRCABJ1
- DO CHK
- DO LIST
- DO CHK
- DO COMMENT
- +5 DO CHK
- DO WRKLD
- DO CHK
- DO EFT
- DO CHK
- DO CBO
- DO CHK
- DO ABAUDIT
- DO CHK
- DO ARDM
- DO CHK
- DO CLNMTR
- +6 DO NOW^%DTC
- SET $PIECE(^RC(342,1,0),"^",10)=%
- +7 LOCK -^RC("PRCABJ")
- +8 KILL ^RC("PRCABJ")
- +9 QUIT
- +10 ;
- CHK ;checkpoint of process
- +1 SET CHK=CHK+1
- SET ^RC("PRCABJ")=CHK
- +2 QUIT
- +3 ;
- VERIFY ;Verifies Pointer Files--Will HALT Process if Pointer Files Invalid
- +1 NEW A,B,FILE
- +2 FOR FILE=341.1,430.2,430.3
- Begin DoDot:1
- +3 SET A=$SELECT(FILE=341.1:"AC;0;2",FILE=430.2:"AC;0;7",1:"AC;0;3")
- +4 SET B=$SELECT(FILE=341.1:"",1:"C;0;2")
- +5 DO EN1^PRCABJV(FILE,A,B,.ERROR)
- +6 if 'ERROR
- QUIT
- +7 ;SEND BULLETIN HERE IF FILE IN ERROR
- +8 NEW XMB,XMTEXT,XMDUZ
- +9 SET XMDUZ="ACCOUNTS RECEIVABLE PACKAGE"
- +10 SET XMB="PRCA NIGHTLY PROCESS ABORT"
- +11 SET XMTEXT="ERROR("
- +12 DO ^XMB
- +13 QUIT
- End DoDot:1
- if ERROR
- QUIT
- +14 QUIT
- +15 ;
- INT ; update interest and admin charges for non-benefit debts
- +1 ; example: vendor, employee, ex-employee
- +2 DO NONBENE^RCBECHGS
- +3 QUIT
- +4 ;
- STM ;Update statement days for PERSONS, VENDORS, and Institutions
- +1 DO STM^PRCABJ1
- +2 QUIT
- +3 ;
- STATMNT ;Print patient statements
- +1 NEW IOP,ZTIO,ZTSAVE,ZTRTN,ZTDESC,ZTASK,%ZIS,ZTDTH,PRCADEV
- +2 SET (IOP,PRCADEV)=$PIECE($GET(^RC(342,1,0)),"^",8)
- +3 IF IOP]""
- Begin DoDot:1
- +4 SET ZTRTN="PRCAGS"
- SET ZTDTH=$HOROLOG
- SET ZTDESC="Print AR Statements/Letters"
- +5 SET %ZIS="N0"
- DO ^%ZIS
- if POP
- QUIT
- +6 SET ZTSAVE("PRCADEV")=""
- DO ^%ZTLOAD
- DO ^%ZISC
- End DoDot:1
- +7 QUIT
- +8 ;
- RECPT ;Manage Receipts and Deposits
- +1 NEW IOP,ZTIO,ZTSAVE,ZTRTN,ZTDESC,ZTASK,%ZIS,ZTDTH
- +2 SET ZTIO=""
- SET ZTRTN="MAN^RCDPUT"
- SET ZTDTH=$HOROLOG
- SET ZTDESC="Manage Receipts and Deposits"
- +3 DO ^%ZTLOAD
- +4 QUIT
- +5 ;
- TOP ;Transmit TOP documents
- +1 if $$DOW^XLFDT(DT,1)'=1
- QUIT
- +2 IF DT'<$PIECE($GET(^RC(342,1,30)),"^",1)&(DT'>$PIECE($GET(^RC(342,1,30)),"^",2))
- DO ^RCEXINAD
- +3 NEW RCM,RCDOC
- +4 ;Run of TOP documents every Monday
- +5 IF +$EXTRACT(DT,6,7)>7
- IF $EXTRACT(DT,6,7)<15
- SET RCM=1
- +6 IF '$DATA(^RCD(340,"TOP"))
- IF '$GET(RCM)
- QUIT
- +7 SET RCDOC=$SELECT($GET(RCM):"M",1:"U")
- +8 IF $EXTRACT(DT,4,5)=12
- IF RCDOC="M"
- SET RCDOC="Y"
- TOPQUE NEW ZTDESC,ZTASK,ZTDTH,ZTIO,ZTRTN,ARDUZ,ZTSAVE
- +1 SET ZTIO=""
- SET ZTRTN="^RCTOPD"
- SET ZTSAVE("RCDOC")=""
- +2 SET ZTDESC="TOP REFERRAL DOCUMENTS"
- SET ZTDTH=$HOROLOG
- +3 DO ^%ZTLOAD
- +4 QUIT
- +5 ;
- TCSP ;Transmit Cross-Servicing (Treasury Cross-Servicing Project) documents
- +1 if $$DOW^XLFDT(DT,1)'=2
- QUIT
- +2 ;Run TCSP documents every Tuesday
- TCSPQUE NEW ZTDESC,ZTASK,ZTDTH,ZTIO,ZTRTN
- +1 SET ZTIO=""
- SET ZTRTN="^RCTCSPD"
- +2 SET ZTDESC="CROSS-SERVICING REFERRAL DOCUMENTS"
- SET ZTDTH=$HOROLOG
- +3 DO ^%ZTLOAD
- +4 QUIT
- +5 ;
- UB ;Print Uniform Billing forms
- +1 NEW IOP,ZTIO,ZTSAVE,ZTRTN,ZTDESC,ZTASK,%ZIS,ZTDTH
- +2 SET ZTIO=""
- SET ZTRTN="PRCALT2"
- SET ZTDTH=$HOROLOG
- SET ZTDESC="Print Reimbursable Health Insurance Uniform Billing forms"
- +3 DO ^%ZTLOAD
- DO ^%ZISC
- +4 QUIT
- +5 ;
- LIST ;Print Follow-up List
- +1 NEW IOP,ZTIO,ZTSAVE,ZTRTN,ZTDESC,ZTASK,%ZIS,ZTDTH,BEG,END,PRCADEV
- +2 SET IOP=$PIECE($GET(^RC(342,1,0)),"^",8)
- +3 IF IOP]""
- Begin DoDot:1
- +4 SET %ZIS="N0"
- DO ^%ZIS
- if POP
- QUIT
- +5 SET ZTRTN="DQ1^PRCACM"
- SET ZTDTH=$HOROLOG
- SET PRCADEV=ION_";"_IOST_";"_IOM_";"_IOSL_";"_$GET(IO("DOC"))
- +6 SET (ZTSAVE("BEG"),ZTSAVE("END"))=DT
- SET ZTSAVE("PRCADEV")=""
- SET ZTDESC="Bill Comment Follow-Up List"
- +7 DO ^%ZTLOAD
- DO ^%ZISC
- End DoDot:1
- +8 QUIT
- +9 ;
- +1 NEW IOP,ZTIO,ZTSAVE,ZTRTN,ZTDESC,ZTASK,%ZIS,ZTDTH,BEG,END,PRCADEV
- +2 SET IOP=$PIECE($GET(^RC(342,1,0)),"^",8)
- +3 IF IOP]""
- Begin DoDot:1
- +4 SET %ZIS="N0"
- DO ^%ZIS
- if POP
- QUIT
- +5 SET ZTRTN="DQ2^PRCACM"
- SET ZTDTH=$HOROLOG
- SET PRCADEV=ION_";"_IOST_";"_IOM_";"_IOSL_";"_$GET(IO("DOC"))
- +6 SET (ZTSAVE("BEG"),ZTSAVE("END"))=DT
- SET ZTSAVE("PRCADEV")=""
- SET ZTDESC="Debtor Comment Follow-up List"
- +7 DO ^%ZTLOAD
- DO ^%ZISC
- End DoDot:1
- +8 QUIT
- +9 ;
- WRKLD ; Generates Diagnostic Measures Workload Reports
- +1 NEW ZTDESC,ZTDTH,ZTIO,ZTRTN,ZTSAVE
- +2 SET ZTIO=""
- SET ZTRTN="DQ^RCDMBWLR"
- SET ZTDTH=$HOROLOG
- SET ZTDESC="Diagnostic Measures Workload Reports"
- +3 DO ^%ZTLOAD
- +4 QUIT
- +5 ;
- +6 ;PRCA*4.5*304 new tag ARDM
- ARDM ; Generate AR Diagnostic Measures statistic reports weekly
- +1 NEW ZTDESC,ZTDTH,ZTIO,ZTRTN,ZTSAVE
- +2 ;
- +3 ; run the report
- +4 SET ZTIO=""
- SET ZTRTN="AUTO^RCDPENRU"
- SET ZTDTH=$HOROLOG
- SET ZTDESC="AR Diagnostic Measures Statistical Reports"
- +5 DO ^%ZTLOAD
- +6 QUIT
- +7 ;
- EVNT ;Purge AR Events
- +1 NEW IOP,ZTIO,ZTDESC,ZTASK,ZTIO,ZTRTN,ZTSAVE,%ZIS
- +2 SET ZTIO=""
- SET ZTRTN="PUR^RCEVDRV1"
- SET ZTDTH=$HOROLOG
- SET ZTDESC="Purge AR Event Information"
- DO ^%ZTLOAD
- +3 QUIT
- PURFMS ;Purge FMS documents
- +1 NEW ZTRTN,ZTIO,ZTDTH,ZTSK,ZTDESC
- +2 SET ZTIO=""
- SET ZTRTN="EN^RCFMPUR"
- SET ZTDESC="AR/FMS DOC PURGE"
- SET ZTDTH=$HOROLOG
- DO ^%ZTLOAD
- +3 QUIT
- +4 ;
- EFT ; Starts matching of EFTs to EOBs job
- +1 NEW ZTRTN,ZTIO,ZTDTH,ZTSK,ZTDESC
- +2 SET ZTIO=""
- SET ZTRTN="EN^RCDPEM"
- SET ZTDESC="AR/EDI LOCKBOX MATCHING EFTs"
- SET ZTDTH=$HOROLOG
- DO ^%ZTLOAD
- +3 QUIT
- +4 ;
- BNUM ;Check bill numbering series
- +1 IF $PIECE(^RC(342,1,0),"^",3)=""
- SET $PIECE(^RC(342,1,0),"^",3)="K"_$EXTRACT($$FY^RCFN01,2)_"00000"
- +2 IF $EXTRACT($PIECE(^RC(342,1,0),"^",3),2)'=$EXTRACT($$FY^RCFN01,2)
- SET $PIECE(^RC(342,1,0),"^",3)="K"_$EXTRACT($$FY^RCFN01,2)_"00000"
- +3 QUIT
- ENUM ;Check event numbering series
- +1 IF $PIECE(^RC(342,1,0),"^",6)=""
- SET $PIECE(^RC(342,1,0),"^",6)="K"_$EXTRACT($$FY^RCFN01,2)_"A0000"
- +2 IF $EXTRACT($PIECE(^RC(342,1,0),"^",6),2)'=$EXTRACT($$FY^RCFN01,2)
- SET $PIECE(^RC(342,1,0),"^",6)="K"_$EXTRACT($$FY^RCFN01,2)_"A0000"
- +3 QUIT
- +4 ;
- CBO ; Create Extract Files for ARC
- +1 NEW ZTRTN,ZTIO,ZTDTH,ZTSK,ZTDESC
- +2 SET ZTIO=""
- SET ZTRTN="EN^RCXVTSK"
- SET ZTDESC="CBO DATA EXTRACT"
- SET ZTDTH=$HOROLOG
- +3 DO ^%ZTLOAD
- +4 QUIT
- +5 ;
- ABAUDIT ;PRCA*4.5*304 - Auto-audit Paper bills
- +1 ;
- +2 NEW ZTRTN,ZTIO,ZTDTH,ZTSK,ZTDESC
- +3 ;
- +4 SET ZTIO=""
- SET ZTRTN="ABAUDIT^PRCABJ2"
- SET ZTDESC="AR AUTO-AUDIT OF PAPER BILLS"
- SET ZTDTH=$HOROLOG
- DO ^%ZTLOAD
- +5 QUIT
- +6 ;
- RPP ;PRCA*4.5*378 - Repayment Plan Nightly Process
- +1 ;
- +2 NEW ZTRTN,ZTIO,ZTDTH,ZTSK,ZTDESC
- +3 ;
- +4 SET ZTIO=""
- SET ZTRTN="MAIN^RCRPNP"
- SET ZTDESC="AR REPAYMENT PLAN NIGHTLY PROCESS"
- SET ZTDTH=$HOROLOG
- DO ^%ZTLOAD
- +5 QUIT
- +6 ;
- CLNMTR ;PRCA*4.5*378 - Remove AR Metrics file data older than the # days specified by the METRICS RETENTION DAYS parameter
- +1 ;
- +2 NEW ZTRTN,ZTIO,ZTDTH,ZTSK,ZTDESC
- +3 ;
- +4 SET ZTIO=""
- SET ZTRTN="CLEANUP^RCSTATU"
- SET ZTDESC="AR METRICS File (#340.7) data cleanup"
- SET ZTDTH=$HOROLOG
- DO ^%ZTLOAD
- +5 QUIT
- +6 ;
- RECALL ; if HRFS patient flag is set or date of death is set, then recall CS bills, stop TOP referrals, and remove debtors from DMC PRCA*4.5*400
- +1 NEW HRFSFLG,RCBILL,RCDB,RCDFN,Z
- +2 ; CS bills
- +3 SET RCBILL=0
- FOR
- SET RCBILL=$ORDER(^PRCA(430,"TCSP",RCBILL))
- if 'RCBILL
- QUIT
- Begin DoDot:1
- +4 SET RCDB=$PIECE($GET(^PRCA(430,RCBILL,0)),U,9)
- if RCDB'>0
- QUIT
- +5 ; recall has already been set for this bill
- IF +$PIECE($GET(^PRCA(430,RCBILL,15)),U,2)
- QUIT
- +6 SET Z=$PIECE(^RCD(340,RCDB,0),U)
- IF $PIECE(Z,";",2)'="DPT("
- QUIT
- +7 SET RCDFN=$PIECE(Z,";")
- SET HRFSFLG=$$CHKHRFS^RCHRFSUT(RCDFN,DT)
- +8 IF HRFSFLG=1
- SET Z=$$RECALL^RCTCSPU(RCBILL)
- +9 QUIT
- End DoDot:1
- +10 ; TOP referrals
- +11 SET RCDB=0
- FOR
- SET RCDB=$ORDER(^RCD(340,"TOP",RCDB))
- if 'RCDB
- QUIT
- Begin DoDot:1
- +12 SET Z=$PIECE(^RCD(340,RCDB,0),U)
- IF $PIECE(Z,";",2)'="DPT("
- QUIT
- +13 ; stop TOP referral flag has been set already
- IF +$PIECE($GET(^RCD(340,RCDB,6)),U,2)
- QUIT
- +14 SET RCDFN=$PIECE(Z,";")
- SET HRFSFLG=$$CHKHRFS^RCHRFSUT(RCDFN,DT)
- +15 IF HRFSFLG=1
- SET Z=$$STOPREF^RCTOPU(RCDB,"O","High Risk flag is set for this debtor",DT)
- DO HRFSCMNT^RCEVGEN(RCDB)
- +16 QUIT
- End DoDot:1
- +17 ; cancel DMC
- +18 SET RCDB=0
- FOR
- SET RCDB=$ORDER(^RCD(340,"DMC",1,RCDB))
- if 'RCDB
- QUIT
- Begin DoDot:1
- +19 SET Z=$PIECE(^RCD(340,RCDB,0),U)
- IF $PIECE(Z,";",2)'="DPT("
- QUIT
- +20 ; DMC deletion flag has been set already
- IF +$PIECE($GET(^RCD(340,RCDB,3)),U,10)
- QUIT
- +21 SET RCDFN=$PIECE(Z,";")
- SET HRFSFLG=$$CHKHRFS^RCHRFSUT(RCDFN,DT)
- +22 IF HRFSFLG=1
- SET Z=$$CANCDMC^RCDMC90U(RCDB)
- DO HRFSCMNT^RCEVGEN(RCDB)
- +23 QUIT
- End DoDot:1
- +24 QUIT