PRCA399P ;MNTVBB/RGB - Patient bills reset AFTER 382/385 ; 2/22/22
;;4.5;Accounts Receivable;**399**;Feb 05, 2022;Build 67
;;Per VA Directive 6402, this routine should not be modified.
Q
EN S PRCASITE=$E($$SITE^RCMSITE(),1,3),PRCASTNM=$P(^DIC(4,PRCASITE,0),U)
I $D(^XTMP("PRCA399",$J,998)) W !!,"*********CANNOT RUN BACK TO BACK WITHOUT SPECIAL RESTORE ********" Q
D MES^XPDUTL("Reset all AR debtors bills that had an incorrect posting")
D MES^XPDUTL("of Covid decrease adjustments for interest/admin fees")
D MES^XPDUTL("")
D MES^XPDUTL("SITE: "_PRCASITE_" - "_PRCASTNM)
K ^XTMP("PRCA399")
S ^XTMP("PRCA399",0)=$$FMADD^XLFDT(DT,150)_"^"_DT
S ^XTMP("PRCA399",$J,1,0)=0,^XTMP("PRCA399",$J,2,0)=0
D NOW^%DTC S ^XTMP("PRCA399",$J,999,"ASTART382/385 FIX")=%
D NOW^%DTC S ^XTMP("PRCA399",$J,999,"B1FINDBILS399")=%
D SETTAB,FINDF1ST,BILLDT
S U="^",(PRCAT,PRCAT1,PRCAT2,PRCAT3,PRCAT4,PRCAT5,PRCAPRT)=0,PRCAZ=+$G(^XTMP("PRCA399",$J,0,0))
S PRCATX=PRCAF1ST
F S PRCATX=$O(^PRCA(433,PRCATX)) Q:'PRCATX D
.S PRCAR=$G(^PRCA(433,PRCATX,5)) Q:PRCAR'["PANDEMIC REVERSAL"
.S PRCAT=PRCAT+1
.S PRCABILL=$P($G(^PRCA(433,PRCATX,0)),U,2),PRCADEB=$P(^PRCA(430,PRCABILL,0),U,9)
.I '$D(^RCD(340,PRCADEB,0))!($P(^RCD(340,PRCADEB,0),U)'[";DPT") Q
.I ";16;42;"'[(";"_$P($G(^PRCA(430,PRCABILL,0)),U,8)_";") Q:'$D(^XTMP("PRCA399",$J,3,PRCADEB,PRCABILL)) S PRCAT5=PRCAT5+1
.I '$D(^XTMP("PRCA399",$J,2,1,PRCADEB)) D
..S ^XTMP("PRCA399",$J,2,1,PRCADEB)="*",^XTMP("PRCA399",$J,2,1,PRCADEB,0)="0^0"
..S PRCAT2=PRCAT2+1,$P(^XTMP("PRCA399",$J,2,1,PRCADEB),U,2)=$P(^XTMP("PRCA399",$J,2,1,0),U)
.S ^XTMP("PRCA399",$J,2,1,PRCADEB,2,PRCABILL)="*"
.I '$D(^XTMP("PRCA399",$J,1,1,PRCABILL)) D
..S PRCAT1=PRCAT1+1
..S ^XTMP("PRCA399",$J,2,1,PRCADEB,0,PRCABILL)="0^0"
..S ^XTMP("PRCA399",$J,2,1,PRCADEB,2,PRCABILL)=""
..F J=0,6,7 S ^XTMP("PRCA399",$J,1,1,PRCABILL,J)=$G(^PRCA(430,PRCABILL,J))
..S PRCAR7=$G(^PRCA(430,PRCABILL,7))
..S ^XTMP("PRCA399",$J,1,1,PRCABILL,99,PRCATX,1)=^PRCA(433,PRCATX,1)
.S PRCABDT=$P($G(^PRCA(430,PRCABILL,6)),U,21) S:PRCABDT PRCABDT=PRCABDT-0.001 I 'PRCABDT S PRCABDT=0
.S ^XTMP("PRCA399",$J,2,4,PRCADEB,PRCABDT,PRCABILL)=""
.I $P(PRCAR7,U,2)<0!($P(PRCAR7,U,3)<0) S ^XTMP("PRCA399",$J,1,1,PRCABILL,"8B")=PRCAR7,PRCAT3=PRCAT3+1 I PRCAZ W !,PRCABILL,?15,PRCAR7 R:PRCAZ PRCAZ:10
D MES^XPDUTL(""),MES^XPDUTL("")
D MES^XPDUTL("FIRST TRANSACTION SET FOR INT/ADMIN PANDEMIC OFFSETS: "_PRCAF1ST)
D MES^XPDUTL("TOTAL DEBTORS FOUND WITH PANDEMIC OFFSETS: "_PRCAT2)
D MES^XPDUTL("TOTAL BILLS FOUND FOR PANDEMIC RESET (382/385): "_PRCAT1)
D MES^XPDUTL("TOTAL PANDEMIC ADJ TX FOUND FORCING BILL RESETS: "_PRCAT)
D MES^XPDUTL("TOTAL BILLS WITH '-' IN NODE 7: "_PRCAT3)
D NOW^%DTC S ^XTMP("PRCA399",$J,999,"B2ENDFINDBILS")=%_U_PRCAT2_U_PRCAT1_U_PRCAT5_U_PRCAT_U_PRCAT3
K PRCAT,PRCAT1,PRCAT2,PRCAT3,PRCATX,PRCAR,PRCABILL,PRCADEB,PRCAR7,PRCAZ,PRCASTNM
D ALLDEBTS
D EN^PRCA399E,5^PRCA399E
D EN^PRCA399A
RESET ;SET BAD TX,SET 7 NODES,REPORT OF EXCEPTIONS,REPORT OF PREPAYS
D 14^PRCA399E,15^PRCA399E,16^PRCA399E,20^PRCA399E S ^XTMP("PRCA399",$J,998)="RUN: "_$H
D MES^XPDUTL(""),MES^XPDUTL("")
D MES^XPDUTL(" *** THE REBUILD OF THE AR FILES IN PATCH PRCA*4.5*399 IS COMPLETE ***")
D MES^XPDUTL(""),MES^XPDUTL("RUN OPTION 'STATEMENT DISCREPANCY LISTING' TO CHECK FOR DEBTOR DISCREPANCIES")
D NOW^%DTC S ^XTMP("PRCA399",$J,999,"ZZENDOF399RESET")=%
K ^TMP("PRCACD",$J)
K I,J,PRCADBT,PRCABILL,PRCACD,PRCADEB,PRCAF1ST,PRCAR,PRCAR7,PRCASITE,PRCABDT,PRCADBB,PRCATYR
K PRCASTNM,PRCAT,PRCAT1,PRCAT2,PRCAT3,PRCAT4,PRCAT5,PRCATX,PRCAZ,DIC,PRCABLDT,PRCASITE
Q
FINDF1ST ;Searches file 433 for first 'PANDEMIC OFFSET' to drive bill reset process
S PRCADEB=0,PRCABTX=$P(^PRCA(433,0),U,3)
F S PRCADEB=$O(^PRCA(430,"C",PRCADEB)),PRCABDT=3210500,PRCAYES=0 Q:'PRCADEB D
.F S PRCABDT=$O(^PRCA(433,"ATD",PRCADEB,PRCABDT)),PRCATX=0 Q:'PRCABDT D Q:PRCAYES
..F S PRCATX=$O(^PRCA(433,"ATD",PRCADEB,PRCABDT,PRCATX)) Q:'PRCATX D Q:PRCAYES
...Q:'$D(^PRCA(433,PRCATX,5))
...Q:$G(^PRCA(433,PRCATX,5))'["PANDEMIC REV"
...I PRCATX'<PRCABTX Q
...S PRCABTX=PRCATX,PRCAYES=1
S PRCAF1ST=PRCABTX-10,^XTMP("PRCA399",$J,1,0,0)=PRCAF1ST
Q
SETTAB ;SET TX CODE TABLE IN TEMP GLOBAL
K ^TMP("PRCACD")
F II=1:1 S PRCACD=$P($T(TXCODES+II),";",3) Q:PRCACD="" S ^TMP("PRCACD",$J,+PRCACD)=$P(PRCACD,":",2)
Q
BILLDT ;FIND PREVIOUS/CURRENT MONTH STATEMENT DATE BASED ON INSTALL DATE VS STATEMENT DAY
N PRCABDAY,PRCAPRVD,PRCANEWD,PRCABILD
S PRCABILD=$P(^RC(342,1,0),U,11)
S PRCABDAY=$E(DT,1,5)_$E("00",1,2-$L(PRCABILD))_PRCABILD
S X1=PRCABDAY-100,X2=-3 D C^%DTC
S PRCAPRVD=X_".05",PRCASETD=PRCAPRVD
S X1=PRCABDAY,X2=-3 D C^%DTC
S PRCANEWD=X_".05",PRCASETD=PRCAPRVD I (DT_".0501")>PRCANEWD S PRCASETD=PRCANEWD
S ^XTMP("PRCA399",$J,2,1,0)=PRCASETD_U_PRCABILD_U_PRCASITE_U_PRCABDAY
Q
GETDBTIM ;Get debtor last statement build end time **NOT CALLED**
N PRCABDAT,PRCACDT
S PRCACDT=$P(^XTMP("PRCA399",$J,2,1,0),U)
S (PRCACDT,PRCASCDT)=9999999.999999-PRCABDAT
S PRCACDT=$O(^RC(341,"AD",PRCADEB,2,PRCACDT))
I 'PRCACDT!(PRCACDT\1'=(PRCASCDT\1)) S PRCACDT=PRCABDAT
S $P(^XTMP("PRCA399",$J,2,1,PRCADEB),U,2)=PRCACDT
S ^XTMP("PRCA399",$J,2,1,0)=PRCABDAT_U_PRCABILD_U_PRCASITE_U_PRCASDAY
Q
ALLDEBTS ;GATHER REST OF DEBTORS/BILLS NOT HIT BY 382/385
S (PRCATB1,PRCADB)=0
D NOW^%DTC S ^XTMP("PRCA399",$J,999,"B3FINDNONCOVIDDEBTORSBILLS")=%
F S PRCADB=$O(^XTMP("PRCA399",$J,2,1,PRCADB)),PRCADBB=0 Q:'PRCADB D
.D CURTX
.F S PRCADBB=$O(^PRCA(430,"C",PRCADB,PRCADBB)),PRCATX=0 Q:'PRCADBB D
..I ";16;42;"'[(";"_$P($G(^PRCA(430,PRCADBB,0)),U,8)_";") Q:'$D(^XTMP("PRCA399",$J,3,PRCADB,PRCADBB)) ;######
..I '$D(^XTMP("PRCA399",$J,1,1,PRCADBB)) D
...S PRCATB1=PRCATB1+1
...F J=0,6,7 S ^XTMP("PRCA399",$J,1,1,PRCADBB,J)=$G(^PRCA(430,PRCADBB,J))
...S ^XTMP("PRCA399",$J,2,1,PRCADB,0,PRCADBB)="0^0"
...S ^XTMP("PRCA399",$J,2,1,PRCADB,2,PRCADBB)=""
...S PRCABDT=$P($G(^PRCA(430,PRCADBB,6)),U,21) S PRCABDT=$S('PRCABDT:PRCABDT=0,1:PRCABDT-.001)
...S ^XTMP("PRCA399",$J,2,4,PRCADB,PRCABDT,PRCADBB)=""
D NOW^%DTC S ^XTMP("PRCA399",$J,999,"B4ENDNONCOVIDDEBTORSBILLS")=%
D MES^XPDUTL(""),MES^XPDUTL("")
D MES^XPDUTL("TOTAL PANDEMIC DEBTOR NON-PANDEMIC BILLS FOUND: "_PRCATB1)
K PRCATB1,PRCADB,PRCADBB,PRCABDT
Q
CURTX N PRCATX,PRCADTCK S PRCADTCK=PRCASETD
F S PRCADTCK=$O(^PRCA(433,"ATD",PRCADB,PRCADTCK)),PRCATX=0 Q:'PRCADTCK D
.S PRCATX=0
.F S PRCATX=$O(^PRCA(433,"ATD",PRCADB,PRCADTCK,PRCATX)) Q:'PRCATX D
..S ^XTMP("PRCA399",$J,3,PRCADB,$P(^PRCA(433,PRCATX,0),U,2),PRCATX)=^PRCA(433,PRCATX,1)
Q
;
TXCODES ;TRANSACTION CODES
;;1:INCREASE ADJUSTMENT^AJ^1^1^^1^I^^A1
;;2:PAYMENT (IN PART)^PP^2^1^^1^P^^D1
;;3:REFER TO RC^RC^3^0^^1^^^ZZ
;;4:REFER TO DOJ^RJ^4^0^^1^^^ZZ
;;5:REESTABLISH TO RC/DOJ^RR^5^0^^1^^^ZZ
;;6:RETURNED BY RC/DOJ^RD^6^0^^1^^^ZZ
;;7:CASH COLLECTION BY RC/DOJ^CJ^7^1^^1^P^^ZZ
;;8:TERM.BY FIS.OFFICER^TO^8^1^^1^D^^D1
;;9:TERM.BY COMPROMISE^TC^9^1^^1^D^^ZZ
;;10:WAIVED IN FULL^WF^10^1^^1^D^^D1
;;11:WAIVED IN PART^WP^11^1^^1^D^^D1
;;12:ADMIN.COST CHARGE^AC^12^0^^1^I^^A3
;;13:INTEREST/ADM. CHARGE^IC^13^0^^1^I^^A2
;;14:EXEMPT INT/ADM. COST^E^14^0^^1^D^^D2
;;15:INCOMPLETE^IN^101^0^^0^^^ZZ
;;16:ACTIVE^A^102^0^1^1^^^ZZ
;;17:IN-ACTIVE^IA^103^0^1^^^^ZZ
;;18:NEW BILL^N^104^0^^1^^^ZZ
;;19:SUSPENSE^S^105^0^1^1^^^ZZ
;;20:PENDING APPROVAL^PA^205^0^^0^^^ZZ
;;21:PENDING CALM CODE^PC^107^0^1^0^^^ZZ
;;22:COLLECTED/CLOSED^CC^108^0^1^1^^^ZZ
;;23:WRITE-OFF^WO^109^0^1^1^D^^D1;rep tot
;;24:MARSHAL/COURT COST^ML^15^0^^1^I^^ZZ
;;25:REPAYMENT PLAN^RP^16^0^^0^^^
;;26:CANCELLED BILL^CB^210^0^^1^^^D1
;;27:BILL INCOMPLETE^BI^201^0^^0^^^ZZ
;;28:OLD BILL^OB^106^0^^0^^^ZZ
;;29:TERM.BY RC/DOJ^TJ^29^1^^1^D^^ZZ
;;30:DEBIT VOUCHER (SF 5515)^DV^30^1^^0^^^ZZ
;;31:RETURNED FROM AR (NEW)^RT^220^0^^0^^^ZZ
;;32:RETURNED FOR AMENDMENT^RA^230^0^^0^^^ZZ
;;33:AMENDED BILL^AB^110^1^^0^^^ZZ
;;34:PAYMENT (IN FULL)^PF^20^1^^1^P^^D1
;;35:DECREASE ADJUSTMENT^DA^21^1^^1^D^^D1
;;36:DELETE (AMEND)^DL^301^0^^0^^ZZ
;;37:ADD (AMEND)^AD^302^0^^0^^^ZZ
;;38:AMEND^AM^303^0^^0^^^ZZ
;;39:CANCELLATION^CN^111^1^0^1^^^D1
;;40:SUSPENDED^SP^240^0^0^1^^^ZZ
;;41:REFUNDED^RF^120^1^0^1^^^AA
;;42:OPEN^OP^112^1^0^1^^^ZZ
;;43:RE-ESTABLISH^RW^250^^^1^I^^AA
;;44:REFUND REVIEW^PR^113^0^0^1^^^ZZ
;;45:COMMENT^CM^17^0^0^0^^^ZZ
;;46:UNSUSPENDED^US^18^0^0^1^^^A1
;;47:CHARGE SUSPENDED^CS^19^0^0^1^D^^A1
;;48:PENDING ARCHIVE^X^114^0^0^0^^^ZZ
;;49:ARCHIVED^XX^115^0^0^0^^^ZZ
;;51:CS STOP PLACED^CP^33^^^0^^^ZZ
;;53:CS BILL RECALL^CR^34^^^0^^^ZZ
;;54:CS STOP DELETED^CD^36^^^0^^^ZZ
;;55:CS DEL BILL RECALL^CF^37^^^0*^^^ZZ
;;56:CS DEBTOR RECALL^CE^35^^^0*^^^ZZ
;;57:CS DEL DEBTOR RECALL^CL^38^^^0^^^ZZ
;;60:CS UPDATE DEBT^CU^41^^^0^^^ZZ
;;64:CS CASE RECALL^CO^45^^^0^^^ZZ
;;65:CS DEL CASE RECALL^CG^46^^^0^^^ZZ
;;66:CS DECR ADJ NOT APP^CA^40^^^0^^^ZZ
;;67:CS ADD CASE INFO^CZ^47^^^0^^^ZZ
;;68:CS NEW DBTR NEW BILL^CH^48^^^0^^^ZZ
;;70:CS DECREASE ADJ^CY^49^^^0^^^D1
;;71:CS RECON WORKED^CV^50^^^^^^ZZ
;;72:DEL REPAY PLAN^DP^31^0^^0^^^ZZ
;;73:CS INCREASE ADJ^AI^51^1^^1^^^A1
;;74:CS ADMIN.COST CHARGE^AE^52^0^^1^^^A3
;;75:CS ADMIN ADJ TR REV?Y^AN^53^^^0^^^ZZ
;;76:CS ADMIN ADJ TR REV?N^AO^54^^^0^^^ZZ
;;79:CS INC ADJ TR REV?Y^AS^57^^^0^^^A1
;;80:CS INC ADJ TR REV?N^AT^58^^^0^^^A1
;;83:CS PEND RECON^RK^61^^^0^^^ZZ
;;84:CS RECALL PLACED^CQ^62^^^^^^ZZ
;;85:CS DEBTOR NEW BILL^CK^39^^^0^^^ZZ
;;86:CS RE-REFER BILL REQUEST^RR^63^^^0^^^ZZ
;;87:CS DEBTOR RE-REFER BILL^RS^64^^^0^^^ZZ
;;88:CS RE-REFER BILL CANCEL^RC^65^^^0^^^ZZ
;;89:CS AUTO RECALL BILL <$25^AR^66^^^1^^^ZZ
;;90:EDIT REPAYMENT PLAN^EZ^67^0^^0^^^ZZ
;;91:CLOSE REPAYMENT PLAN^RZ^68^0^^0^^^ZZ
;;92:RPP TERMINATED^RT^69^0^^0^^^ZZ
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRCA399P 9835 printed Jul 11, 2026@01:35:32 Page 2
PRCA399P ;MNTVBB/RGB - Patient bills reset AFTER 382/385 ; 2/22/22
+1 ;;4.5;Accounts Receivable;**399**;Feb 05, 2022;Build 67
+2 ;;Per VA Directive 6402, this routine should not be modified.
+3 QUIT
EN SET PRCASITE=$EXTRACT($$SITE^RCMSITE(),1,3)
SET PRCASTNM=$PIECE(^DIC(4,PRCASITE,0),U)
+1 IF $DATA(^XTMP("PRCA399",$JOB,998))
WRITE !!,"*********CANNOT RUN BACK TO BACK WITHOUT SPECIAL RESTORE ********"
QUIT
+2 DO MES^XPDUTL("Reset all AR debtors bills that had an incorrect posting")
+3 DO MES^XPDUTL("of Covid decrease adjustments for interest/admin fees")
+4 DO MES^XPDUTL("")
+5 DO MES^XPDUTL("SITE: "_PRCASITE_" - "_PRCASTNM)
+6 KILL ^XTMP("PRCA399")
+7 SET ^XTMP("PRCA399",0)=$$FMADD^XLFDT(DT,150)_"^"_DT
+8 SET ^XTMP("PRCA399",$JOB,1,0)=0
SET ^XTMP("PRCA399",$JOB,2,0)=0
+9 DO NOW^%DTC
SET ^XTMP("PRCA399",$JOB,999,"ASTART382/385 FIX")=%
+10 DO NOW^%DTC
SET ^XTMP("PRCA399",$JOB,999,"B1FINDBILS399")=%
+11 DO SETTAB
DO FINDF1ST
DO BILLDT
+12 SET U="^"
SET (PRCAT,PRCAT1,PRCAT2,PRCAT3,PRCAT4,PRCAT5,PRCAPRT)=0
SET PRCAZ=+$GET(^XTMP("PRCA399",$JOB,0,0))
+13 SET PRCATX=PRCAF1ST
+14 FOR
SET PRCATX=$ORDER(^PRCA(433,PRCATX))
if 'PRCATX
QUIT
Begin DoDot:1
+15 SET PRCAR=$GET(^PRCA(433,PRCATX,5))
if PRCAR'["PANDEMIC REVERSAL"
QUIT
+16 SET PRCAT=PRCAT+1
+17 SET PRCABILL=$PIECE($GET(^PRCA(433,PRCATX,0)),U,2)
SET PRCADEB=$PIECE(^PRCA(430,PRCABILL,0),U,9)
+18 IF '$DATA(^RCD(340,PRCADEB,0))!($PIECE(^RCD(340,PRCADEB,0),U)'[";DPT")
QUIT
+19 IF ";16;42;"'[(";"_$PIECE($GET(^PRCA(430,PRCABILL,0)),U,8)_";")
if '$DATA(^XTMP("PRCA399",$JOB,3,PRCADEB,PRCABILL))
QUIT
SET PRCAT5=PRCAT5+1
+20 IF '$DATA(^XTMP("PRCA399",$JOB,2,1,PRCADEB))
Begin DoDot:2
+21 SET ^XTMP("PRCA399",$JOB,2,1,PRCADEB)="*"
SET ^XTMP("PRCA399",$JOB,2,1,PRCADEB,0)="0^0"
+22 SET PRCAT2=PRCAT2+1
SET $PIECE(^XTMP("PRCA399",$JOB,2,1,PRCADEB),U,2)=$PIECE(^XTMP("PRCA399",$JOB,2,1,0),U)
End DoDot:2
+23 SET ^XTMP("PRCA399",$JOB,2,1,PRCADEB,2,PRCABILL)="*"
+24 IF '$DATA(^XTMP("PRCA399",$JOB,1,1,PRCABILL))
Begin DoDot:2
+25 SET PRCAT1=PRCAT1+1
+26 SET ^XTMP("PRCA399",$JOB,2,1,PRCADEB,0,PRCABILL)="0^0"
+27 SET ^XTMP("PRCA399",$JOB,2,1,PRCADEB,2,PRCABILL)=""
+28 FOR J=0,6,7
SET ^XTMP("PRCA399",$JOB,1,1,PRCABILL,J)=$GET(^PRCA(430,PRCABILL,J))
+29 SET PRCAR7=$GET(^PRCA(430,PRCABILL,7))
+30 SET ^XTMP("PRCA399",$JOB,1,1,PRCABILL,99,PRCATX,1)=^PRCA(433,PRCATX,1)
End DoDot:2
+31 SET PRCABDT=$PIECE($GET(^PRCA(430,PRCABILL,6)),U,21)
if PRCABDT
SET PRCABDT=PRCABDT-0.001
IF 'PRCABDT
SET PRCABDT=0
+32 SET ^XTMP("PRCA399",$JOB,2,4,PRCADEB,PRCABDT,PRCABILL)=""
+33 IF $PIECE(PRCAR7,U,2)<0!($PIECE(PRCAR7,U,3)<0)
SET ^XTMP("PRCA399",$JOB,1,1,PRCABILL,"8B")=PRCAR7
SET PRCAT3=PRCAT3+1
IF PRCAZ
WRITE !,PRCABILL,?15,PRCAR7
if PRCAZ
READ PRCAZ:10
End DoDot:1
+34 DO MES^XPDUTL("")
DO MES^XPDUTL("")
+35 DO MES^XPDUTL("FIRST TRANSACTION SET FOR INT/ADMIN PANDEMIC OFFSETS: "_PRCAF1ST)
+36 DO MES^XPDUTL("TOTAL DEBTORS FOUND WITH PANDEMIC OFFSETS: "_PRCAT2)
+37 DO MES^XPDUTL("TOTAL BILLS FOUND FOR PANDEMIC RESET (382/385): "_PRCAT1)
+38 DO MES^XPDUTL("TOTAL PANDEMIC ADJ TX FOUND FORCING BILL RESETS: "_PRCAT)
+39 DO MES^XPDUTL("TOTAL BILLS WITH '-' IN NODE 7: "_PRCAT3)
+40 DO NOW^%DTC
SET ^XTMP("PRCA399",$JOB,999,"B2ENDFINDBILS")=%_U_PRCAT2_U_PRCAT1_U_PRCAT5_U_PRCAT_U_PRCAT3
+41 KILL PRCAT,PRCAT1,PRCAT2,PRCAT3,PRCATX,PRCAR,PRCABILL,PRCADEB,PRCAR7,PRCAZ,PRCASTNM
+42 DO ALLDEBTS
+43 DO EN^PRCA399E
DO 5^PRCA399E
+44 DO EN^PRCA399A
RESET ;SET BAD TX,SET 7 NODES,REPORT OF EXCEPTIONS,REPORT OF PREPAYS
+1 DO 14^PRCA399E
DO 15^PRCA399E
DO 16^PRCA399E
DO 20^PRCA399E
SET ^XTMP("PRCA399",$JOB,998)="RUN: "_$HOROLOG
+2 DO MES^XPDUTL("")
DO MES^XPDUTL("")
+3 DO MES^XPDUTL(" *** THE REBUILD OF THE AR FILES IN PATCH PRCA*4.5*399 IS COMPLETE ***")
+4 DO MES^XPDUTL("")
DO MES^XPDUTL("RUN OPTION 'STATEMENT DISCREPANCY LISTING' TO CHECK FOR DEBTOR DISCREPANCIES")
+5 DO NOW^%DTC
SET ^XTMP("PRCA399",$JOB,999,"ZZENDOF399RESET")=%
+6 KILL ^TMP("PRCACD",$JOB)
+7 KILL I,J,PRCADBT,PRCABILL,PRCACD,PRCADEB,PRCAF1ST,PRCAR,PRCAR7,PRCASITE,PRCABDT,PRCADBB,PRCATYR
+8 KILL PRCASTNM,PRCAT,PRCAT1,PRCAT2,PRCAT3,PRCAT4,PRCAT5,PRCATX,PRCAZ,DIC,PRCABLDT,PRCASITE
+9 QUIT
FINDF1ST ;Searches file 433 for first 'PANDEMIC OFFSET' to drive bill reset process
+1 SET PRCADEB=0
SET PRCABTX=$PIECE(^PRCA(433,0),U,3)
+2 FOR
SET PRCADEB=$ORDER(^PRCA(430,"C",PRCADEB))
SET PRCABDT=3210500
SET PRCAYES=0
if 'PRCADEB
QUIT
Begin DoDot:1
+3 FOR
SET PRCABDT=$ORDER(^PRCA(433,"ATD",PRCADEB,PRCABDT))
SET PRCATX=0
if 'PRCABDT
QUIT
Begin DoDot:2
+4 FOR
SET PRCATX=$ORDER(^PRCA(433,"ATD",PRCADEB,PRCABDT,PRCATX))
if 'PRCATX
QUIT
Begin DoDot:3
+5 if '$DATA(^PRCA(433,PRCATX,5))
QUIT
+6 if $GET(^PRCA(433,PRCATX,5))'["PANDEMIC REV"
QUIT
+7 IF PRCATX'<PRCABTX
QUIT
+8 SET PRCABTX=PRCATX
SET PRCAYES=1
End DoDot:3
if PRCAYES
QUIT
End DoDot:2
if PRCAYES
QUIT
End DoDot:1
+9 SET PRCAF1ST=PRCABTX-10
SET ^XTMP("PRCA399",$JOB,1,0,0)=PRCAF1ST
+10 QUIT
SETTAB ;SET TX CODE TABLE IN TEMP GLOBAL
+1 KILL ^TMP("PRCACD")
+2 FOR II=1:1
SET PRCACD=$PIECE($TEXT(TXCODES+II),";",3)
if PRCACD=""
QUIT
SET ^TMP("PRCACD",$JOB,+PRCACD)=$PIECE(PRCACD,":",2)
+3 QUIT
BILLDT ;FIND PREVIOUS/CURRENT MONTH STATEMENT DATE BASED ON INSTALL DATE VS STATEMENT DAY
+1 NEW PRCABDAY,PRCAPRVD,PRCANEWD,PRCABILD
+2 SET PRCABILD=$PIECE(^RC(342,1,0),U,11)
+3 SET PRCABDAY=$EXTRACT(DT,1,5)_$EXTRACT("00",1,2-$LENGTH(PRCABILD))_PRCABILD
+4 SET X1=PRCABDAY-100
SET X2=-3
DO C^%DTC
+5 SET PRCAPRVD=X_".05"
SET PRCASETD=PRCAPRVD
+6 SET X1=PRCABDAY
SET X2=-3
DO C^%DTC
+7 SET PRCANEWD=X_".05"
SET PRCASETD=PRCAPRVD
IF (DT_".0501")>PRCANEWD
SET PRCASETD=PRCANEWD
+8 SET ^XTMP("PRCA399",$JOB,2,1,0)=PRCASETD_U_PRCABILD_U_PRCASITE_U_PRCABDAY
+9 QUIT
GETDBTIM ;Get debtor last statement build end time **NOT CALLED**
+1 NEW PRCABDAT,PRCACDT
+2 SET PRCACDT=$PIECE(^XTMP("PRCA399",$JOB,2,1,0),U)
+3 SET (PRCACDT,PRCASCDT)=9999999.999999-PRCABDAT
+4 SET PRCACDT=$ORDER(^RC(341,"AD",PRCADEB,2,PRCACDT))
+5 IF 'PRCACDT!(PRCACDT\1'=(PRCASCDT\1))
SET PRCACDT=PRCABDAT
+6 SET $PIECE(^XTMP("PRCA399",$JOB,2,1,PRCADEB),U,2)=PRCACDT
+7 SET ^XTMP("PRCA399",$JOB,2,1,0)=PRCABDAT_U_PRCABILD_U_PRCASITE_U_PRCASDAY
+8 QUIT
ALLDEBTS ;GATHER REST OF DEBTORS/BILLS NOT HIT BY 382/385
+1 SET (PRCATB1,PRCADB)=0
+2 DO NOW^%DTC
SET ^XTMP("PRCA399",$JOB,999,"B3FINDNONCOVIDDEBTORSBILLS")=%
+3 FOR
SET PRCADB=$ORDER(^XTMP("PRCA399",$JOB,2,1,PRCADB))
SET PRCADBB=0
if 'PRCADB
QUIT
Begin DoDot:1
+4 DO CURTX
+5 FOR
SET PRCADBB=$ORDER(^PRCA(430,"C",PRCADB,PRCADBB))
SET PRCATX=0
if 'PRCADBB
QUIT
Begin DoDot:2
+6 ;######
IF ";16;42;"'[(";"_$PIECE($GET(^PRCA(430,PRCADBB,0)),U,8)_";")
if '$DATA(^XTMP("PRCA399",$JOB,3,PRCADB,PRCADBB))
QUIT
+7 IF '$DATA(^XTMP("PRCA399",$JOB,1,1,PRCADBB))
Begin DoDot:3
+8 SET PRCATB1=PRCATB1+1
+9 FOR J=0,6,7
SET ^XTMP("PRCA399",$JOB,1,1,PRCADBB,J)=$GET(^PRCA(430,PRCADBB,J))
+10 SET ^XTMP("PRCA399",$JOB,2,1,PRCADB,0,PRCADBB)="0^0"
+11 SET ^XTMP("PRCA399",$JOB,2,1,PRCADB,2,PRCADBB)=""
+12 SET PRCABDT=$PIECE($GET(^PRCA(430,PRCADBB,6)),U,21)
SET PRCABDT=$SELECT('PRCABDT:PRCABDT=0,1:PRCABDT-.001)
+13 SET ^XTMP("PRCA399",$JOB,2,4,PRCADB,PRCABDT,PRCADBB)=""
End DoDot:3
End DoDot:2
End DoDot:1
+14 DO NOW^%DTC
SET ^XTMP("PRCA399",$JOB,999,"B4ENDNONCOVIDDEBTORSBILLS")=%
+15 DO MES^XPDUTL("")
DO MES^XPDUTL("")
+16 DO MES^XPDUTL("TOTAL PANDEMIC DEBTOR NON-PANDEMIC BILLS FOUND: "_PRCATB1)
+17 KILL PRCATB1,PRCADB,PRCADBB,PRCABDT
+18 QUIT
CURTX NEW PRCATX,PRCADTCK
SET PRCADTCK=PRCASETD
+1 FOR
SET PRCADTCK=$ORDER(^PRCA(433,"ATD",PRCADB,PRCADTCK))
SET PRCATX=0
if 'PRCADTCK
QUIT
Begin DoDot:1
+2 SET PRCATX=0
+3 FOR
SET PRCATX=$ORDER(^PRCA(433,"ATD",PRCADB,PRCADTCK,PRCATX))
if 'PRCATX
QUIT
Begin DoDot:2
+4 SET ^XTMP("PRCA399",$JOB,3,PRCADB,$PIECE(^PRCA(433,PRCATX,0),U,2),PRCATX)=^PRCA(433,PRCATX,1)
End DoDot:2
End DoDot:1
+5 QUIT
+6 ;
TXCODES ;TRANSACTION CODES
+1 ;;1:INCREASE ADJUSTMENT^AJ^1^1^^1^I^^A1
+2 ;;2:PAYMENT (IN PART)^PP^2^1^^1^P^^D1
+3 ;;3:REFER TO RC^RC^3^0^^1^^^ZZ
+4 ;;4:REFER TO DOJ^RJ^4^0^^1^^^ZZ
+5 ;;5:REESTABLISH TO RC/DOJ^RR^5^0^^1^^^ZZ
+6 ;;6:RETURNED BY RC/DOJ^RD^6^0^^1^^^ZZ
+7 ;;7:CASH COLLECTION BY RC/DOJ^CJ^7^1^^1^P^^ZZ
+8 ;;8:TERM.BY FIS.OFFICER^TO^8^1^^1^D^^D1
+9 ;;9:TERM.BY COMPROMISE^TC^9^1^^1^D^^ZZ
+10 ;;10:WAIVED IN FULL^WF^10^1^^1^D^^D1
+11 ;;11:WAIVED IN PART^WP^11^1^^1^D^^D1
+12 ;;12:ADMIN.COST CHARGE^AC^12^0^^1^I^^A3
+13 ;;13:INTEREST/ADM. CHARGE^IC^13^0^^1^I^^A2
+14 ;;14:EXEMPT INT/ADM. COST^E^14^0^^1^D^^D2
+15 ;;15:INCOMPLETE^IN^101^0^^0^^^ZZ
+16 ;;16:ACTIVE^A^102^0^1^1^^^ZZ
+17 ;;17:IN-ACTIVE^IA^103^0^1^^^^ZZ
+18 ;;18:NEW BILL^N^104^0^^1^^^ZZ
+19 ;;19:SUSPENSE^S^105^0^1^1^^^ZZ
+20 ;;20:PENDING APPROVAL^PA^205^0^^0^^^ZZ
+21 ;;21:PENDING CALM CODE^PC^107^0^1^0^^^ZZ
+22 ;;22:COLLECTED/CLOSED^CC^108^0^1^1^^^ZZ
+23 ;;23:WRITE-OFF^WO^109^0^1^1^D^^D1;rep tot
+24 ;;24:MARSHAL/COURT COST^ML^15^0^^1^I^^ZZ
+25 ;;25:REPAYMENT PLAN^RP^16^0^^0^^^
+26 ;;26:CANCELLED BILL^CB^210^0^^1^^^D1
+27 ;;27:BILL INCOMPLETE^BI^201^0^^0^^^ZZ
+28 ;;28:OLD BILL^OB^106^0^^0^^^ZZ
+29 ;;29:TERM.BY RC/DOJ^TJ^29^1^^1^D^^ZZ
+30 ;;30:DEBIT VOUCHER (SF 5515)^DV^30^1^^0^^^ZZ
+31 ;;31:RETURNED FROM AR (NEW)^RT^220^0^^0^^^ZZ
+32 ;;32:RETURNED FOR AMENDMENT^RA^230^0^^0^^^ZZ
+33 ;;33:AMENDED BILL^AB^110^1^^0^^^ZZ
+34 ;;34:PAYMENT (IN FULL)^PF^20^1^^1^P^^D1
+35 ;;35:DECREASE ADJUSTMENT^DA^21^1^^1^D^^D1
+36 ;;36:DELETE (AMEND)^DL^301^0^^0^^ZZ
+37 ;;37:ADD (AMEND)^AD^302^0^^0^^^ZZ
+38 ;;38:AMEND^AM^303^0^^0^^^ZZ
+39 ;;39:CANCELLATION^CN^111^1^0^1^^^D1
+40 ;;40:SUSPENDED^SP^240^0^0^1^^^ZZ
+41 ;;41:REFUNDED^RF^120^1^0^1^^^AA
+42 ;;42:OPEN^OP^112^1^0^1^^^ZZ
+43 ;;43:RE-ESTABLISH^RW^250^^^1^I^^AA
+44 ;;44:REFUND REVIEW^PR^113^0^0^1^^^ZZ
+45 ;;45:COMMENT^CM^17^0^0^0^^^ZZ
+46 ;;46:UNSUSPENDED^US^18^0^0^1^^^A1
+47 ;;47:CHARGE SUSPENDED^CS^19^0^0^1^D^^A1
+48 ;;48:PENDING ARCHIVE^X^114^0^0^0^^^ZZ
+49 ;;49:ARCHIVED^XX^115^0^0^0^^^ZZ
+50 ;;51:CS STOP PLACED^CP^33^^^0^^^ZZ
+51 ;;53:CS BILL RECALL^CR^34^^^0^^^ZZ
+52 ;;54:CS STOP DELETED^CD^36^^^0^^^ZZ
+53 ;;55:CS DEL BILL RECALL^CF^37^^^0*^^^ZZ
+54 ;;56:CS DEBTOR RECALL^CE^35^^^0*^^^ZZ
+55 ;;57:CS DEL DEBTOR RECALL^CL^38^^^0^^^ZZ
+56 ;;60:CS UPDATE DEBT^CU^41^^^0^^^ZZ
+57 ;;64:CS CASE RECALL^CO^45^^^0^^^ZZ
+58 ;;65:CS DEL CASE RECALL^CG^46^^^0^^^ZZ
+59 ;;66:CS DECR ADJ NOT APP^CA^40^^^0^^^ZZ
+60 ;;67:CS ADD CASE INFO^CZ^47^^^0^^^ZZ
+61 ;;68:CS NEW DBTR NEW BILL^CH^48^^^0^^^ZZ
+62 ;;70:CS DECREASE ADJ^CY^49^^^0^^^D1
+63 ;;71:CS RECON WORKED^CV^50^^^^^^ZZ
+64 ;;72:DEL REPAY PLAN^DP^31^0^^0^^^ZZ
+65 ;;73:CS INCREASE ADJ^AI^51^1^^1^^^A1
+66 ;;74:CS ADMIN.COST CHARGE^AE^52^0^^1^^^A3
+67 ;;75:CS ADMIN ADJ TR REV?Y^AN^53^^^0^^^ZZ
+68 ;;76:CS ADMIN ADJ TR REV?N^AO^54^^^0^^^ZZ
+69 ;;79:CS INC ADJ TR REV?Y^AS^57^^^0^^^A1
+70 ;;80:CS INC ADJ TR REV?N^AT^58^^^0^^^A1
+71 ;;83:CS PEND RECON^RK^61^^^0^^^ZZ
+72 ;;84:CS RECALL PLACED^CQ^62^^^^^^ZZ
+73 ;;85:CS DEBTOR NEW BILL^CK^39^^^0^^^ZZ
+74 ;;86:CS RE-REFER BILL REQUEST^RR^63^^^0^^^ZZ
+75 ;;87:CS DEBTOR RE-REFER BILL^RS^64^^^0^^^ZZ
+76 ;;88:CS RE-REFER BILL CANCEL^RC^65^^^0^^^ZZ
+77 ;;89:CS AUTO RECALL BILL <$25^AR^66^^^1^^^ZZ
+78 ;;90:EDIT REPAYMENT PLAN^EZ^67^0^^0^^^ZZ
+79 ;;91:CLOSE REPAYMENT PLAN^RZ^68^0^^0^^^ZZ
+80 ;;92:RPP TERMINATED^RT^69^0^^0^^^ZZ
