PRCA399Z ;MNTVBB/RGB - Patient bills reset AFTER DISCREPANCY RUN ; 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 !!,"*********sign off and get a new $J as this $J would kill the INITIAL patch 399 recalc detail ********" Q
K ^XTMP("PRCA399",$J) S ^XTMP("PRCA399",$J,1,0)=1
S ^XTMP("PRCA399",0)=$$FMADD^XLFDT(DT,5)_"^"_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")=%
S ^XTMP("PRCA399",$J,999,"B1FINDBILS399")=%,PRCAERR=0
D USTART Q:PRCAERR!'$D(^TMP("PRCAMRKC",$J)) S ^XTMP("PRCA399",$J,1,0,0)=0
XX D SETTAB,BILLDT,FINDF1ST
S U="^",(PRCAT,PRCAT1,PRCAT2,PRCAT3,PRCAT4,PRCAT5,PRCAPRT)=0,PRCAZ=+$G(^XTMP("PRCA399",$J,0,0))
S PRCADEB=0 F S PRCADEB=$O(^TMP("PRCAMRKC",$J,PRCADEB)) Q:'PRCADEB D
.I $P(^TMP("PRCAMRKC",$J,PRCADEB),U,4)>0 Q
.I '$D(^RCD(340,PRCADEB,0))!($P($G(^RCD(340,PRCADEB,0)),U)'[";DPT") Q
.I '$D(^XTMP("PRCA399",$J,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 PRCABILL=$O(^PRCA(430,"C",PRCADEB,0))
CHK0 .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)=""
CHK1 ..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 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
D EN^PRCA399A
;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
I $D(^PRCA(433,"ZZ1ST")) S FINDF1ST=^PRCA(433,"ZZ1ST") Q
S PRCAFIST=0 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,^PRCA(433,"ZZ1ST")=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
USTART ;ASK IF USE TMP GLOBAL OUT OF PRCAMRKC RUN, NEED TO RUN RIGHT AFTER DISCREP RUN
S PRCAERR=0
R !,"USE TEMP FILE OUT OF STATEMENT DISCREPANCY RUN? Y/N: ",PRCAX:DTIME G:PRCAX="N" U
I '$D(^TMP("PRCAMRKC",$J)) W !!,"*** NOTHING IN FILE, MUST SELECT ENTRIES" G U
G U2
U ;KILL ^TMP("PRCAMARK") AND ASK DEBTOR(S)
K ^TMP("PRCAMRKC",$J)
U1 F I=1:1 S RCDEBTDA=0 W !! D SELECT G U2:'RCDEBTDA D
.I $G(^RCD(340,RCDEBTDA,0))'[";DPT" W " ** NOT DEFINED AS PATIENT **" Q
.I '$O(^PRCA(430,"C",RCDEBTDA,0)) W " ** NO BILLS ON FILE FOR DEBTOR **" Q
.I $$REFUREVW^PRCAMRKC(RCDEBTDA) W " ** REFUND REVIEW DEBTOR **"
.S ^TMP("PRCAMRKC",$J,+RCDEBTDA)="" Q
U2 S ^XTMP("PRCA399",$J,1,0)=0
R !,"DO YOU WANT TO SEE COMPLETE DETAIL OF DEBTOR RECALC BILL BY BILL POSTING? Y/N: ",PRCAPRT:20
I PRCAPRT="Y" S ^XTMP("PRCA399",$J,1,0)=1
Q
SELECT N X,Y,DEBT,PRCADB,DA,PRCA,COUNT,OUT,SEL,BILL,BAT,TRAN,DR,DXS
N DPTNOFZY,DPTNOFZK S (DPTNOFZY,DPTNOFZK)=1
ASK K OUT S COUNT=0,PRCADB="",RCDEPTDA=0 R !!,"Select DEBTOR NAME or BILL NUMBER: ",X:DTIME I $E(X)="^"!(X="") S RCDEBTDA=0 Q
S X=$$UPPER^VALM1(X)
S Y=$S($O(^PRCA(430,"B",X,0)):$O(^(0)),$O(^PRCA(430,"D",X,0)):$O(^(0)),1:-1)
I Y>0 S DEBT=$P($G(^PRCA(430,Y,0)),"^",9) I DEBT S PRCADB=$P($G(^RCD(340,DEBT,0)),"^"),^DISV(DUZ,"^PRCA(430,")=Y,$P(DEBT,"^",2)=$$NAM^RCFN01(DEBT)
S DIC="^RCD(340,",DIC(0)="E" D ^DIC G:Y<0 ASK
S ^DISV(DUZ,"^RCD(340,")=+Y,PRCADB=$P(Y,"^",2),DEBT=+Y_"^"_$P(@("^"_$P(PRCADB,";",2)_+PRCADB_",0)"),"^"),PRCADB=+DEBT
S ^TMP("PRCAMRKC",$J,+PRCADB)="",RCDEBTDA=PRCADB
G ASK
CURTX N PRCATX,PRCADTCK S PRCADTCK=PRCASETD
F S PRCADTCK=$O(^PRCA(433,"ATD",PRCADB,PRCADTCK)) 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 ;TRANSACTIN 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^^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[HPRCA399Z 10778 printed Jul 11, 2026@01:35:33 Page 2
PRCA399Z ;MNTVBB/RGB - Patient bills reset AFTER DISCREPANCY RUN ; 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 !!,"*********sign off and get a new $J as this $J would kill the INITIAL patch 399 recalc detail ********"
QUIT
+2 KILL ^XTMP("PRCA399",$JOB)
SET ^XTMP("PRCA399",$JOB,1,0)=1
+3 SET ^XTMP("PRCA399",0)=$$FMADD^XLFDT(DT,5)_"^"_DT
+4 SET ^XTMP("PRCA399",$JOB,1,0)=0
SET ^XTMP("PRCA399",$JOB,2,0)=0
+5 DO NOW^%DTC
SET ^XTMP("PRCA399",$JOB,999,"ASTART382/385 FIX")=%
+6 SET ^XTMP("PRCA399",$JOB,999,"B1FINDBILS399")=%
SET PRCAERR=0
+7 DO USTART
if PRCAERR!'$DATA(^TMP("PRCAMRKC",$JOB))
QUIT
SET ^XTMP("PRCA399",$JOB,1,0,0)=0
XX DO SETTAB
DO BILLDT
DO FINDF1ST
+1 SET U="^"
SET (PRCAT,PRCAT1,PRCAT2,PRCAT3,PRCAT4,PRCAT5,PRCAPRT)=0
SET PRCAZ=+$GET(^XTMP("PRCA399",$JOB,0,0))
+2 SET PRCADEB=0
FOR
SET PRCADEB=$ORDER(^TMP("PRCAMRKC",$JOB,PRCADEB))
if 'PRCADEB
QUIT
Begin DoDot:1
+3 IF $PIECE(^TMP("PRCAMRKC",$JOB,PRCADEB),U,4)>0
QUIT
+4 IF '$DATA(^RCD(340,PRCADEB,0))!($PIECE($GET(^RCD(340,PRCADEB,0)),U)'[";DPT")
QUIT
+5 IF '$DATA(^XTMP("PRCA399",$JOB,PRCADEB))
Begin DoDot:2
+6 SET ^XTMP("PRCA399",$JOB,2,1,PRCADEB)="*"
SET ^XTMP("PRCA399",$JOB,2,1,PRCADEB,0)="0^0"
+7 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
+8 SET PRCABILL=$ORDER(^PRCA(430,"C",PRCADEB,0))
CHK0 IF '$DATA(^XTMP("PRCA399",$JOB,1,1,PRCABILL))
Begin DoDot:2
+1 SET PRCAT1=PRCAT1+1
+2 SET ^XTMP("PRCA399",$JOB,2,1,PRCADEB,0,PRCABILL)="0^0"
+3 SET ^XTMP("PRCA399",$JOB,2,1,PRCADEB,2,PRCABILL)=""
CHK1 FOR J=0,6,7
SET ^XTMP("PRCA399",$JOB,1,1,PRCABILL,J)=$GET(^PRCA(430,PRCABILL,J))
+1 SET PRCAR7=$GET(^PRCA(430,PRCABILL,7))
+2 ;S ^XTMP("PRCA399",$J,1,1,PRCABILL,99,PRCATX,1)=^PRCA(433,PRCATX,1)
End DoDot:2
+3 SET PRCABDT=$PIECE($GET(^PRCA(430,PRCABILL,6)),U,21)
if PRCABDT
SET PRCABDT=PRCABDT-0.001
IF 'PRCABDT
SET PRCABDT=0
+4 SET ^XTMP("PRCA399",$JOB,2,4,PRCADEB,PRCABDT,PRCABILL)=""
+5 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
+6 DO NOW^%DTC
SET ^XTMP("PRCA399",$JOB,999,"B2ENDFINDBILS")=%_U_PRCAT2_U_PRCAT1_U_PRCAT5_U_PRCAT_U_PRCAT3
+7 KILL PRCAT,PRCAT1,PRCAT2,PRCAT3,PRCATX,PRCAR,PRCABILL,PRCADEB,PRCAR7,PRCAZ,PRCASTNM
+8 DO ALLDEBTS
+9 ;D EN^PRCA399E
+10 DO EN^PRCA399A
+11 ;SET BAD TX,SET 7 NODES,REPORT OF EXCEPTIONS,REPORT OF PREPAYS
+12 ;S ^XTMP("PRCA399",$J,998)="RUN: "_$H
DO 14^PRCA399E
DO 15^PRCA399E
DO 16^PRCA399E
DO 20^PRCA399E
+13 DO MES^XPDUTL("")
DO MES^XPDUTL("")
+14 DO MES^XPDUTL(" *** THE REBUILD OF THE AR FILES IN PATCH PRCA*4.5*399 IS COMPLETE ***")
+15 DO MES^XPDUTL("")
DO MES^XPDUTL("RUN OPTION 'STATEMENT DISCREPANCY LISTING' TO CHECK FOR DEBTOR DISCREPANCIES")
+16 DO NOW^%DTC
SET ^XTMP("PRCA399",$JOB,999,"ZZENDOF399RESET")=%
+17 KILL ^TMP("PRCACD",$JOB)
+18 KILL I,J,PRCADBT,PRCABILL,PRCACD,PRCADEB,PRCAF1ST,PRCAR,PRCAR7,PRCASITE,PRCABDT,PRCADBB,PRCATYR
+19 KILL PRCASTNM,PRCAT,PRCAT1,PRCAT2,PRCAT3,PRCAT4,PRCAT5,PRCATX,PRCAZ,DIC,PRCABLDT,PRCASITE
+20 QUIT
FINDF1ST ;Searches file 433 for first 'PANDEMIC OFFSET' to drive bill reset process
+1 IF $DATA(^PRCA(433,"ZZ1ST"))
SET FINDF1ST=^PRCA(433,"ZZ1ST")
QUIT
+2 SET PRCAFIST=0
SET PRCADEB=0
SET PRCABTX=$PIECE(^PRCA(433,0),U,3)
+3 FOR
SET PRCADEB=$ORDER(^PRCA(430,"C",PRCADEB))
SET PRCABDT=3210500
SET PRCAYES=0
if 'PRCADEB
QUIT
Begin DoDot:1
+4 FOR
SET PRCABDT=$ORDER(^PRCA(433,"ATD",PRCADEB,PRCABDT))
SET PRCATX=0
if 'PRCABDT
QUIT
Begin DoDot:2
+5 FOR
SET PRCATX=$ORDER(^PRCA(433,"ATD",PRCADEB,PRCABDT,PRCATX))
if 'PRCATX
QUIT
Begin DoDot:3
+6 if '$DATA(^PRCA(433,PRCATX,5))
QUIT
+7 if $GET(^PRCA(433,PRCATX,5))'["PANDEMIC REV"
QUIT
+8 IF PRCATX'<PRCABTX
QUIT
+9 SET PRCABTX=PRCATX
SET PRCAYES=1
End DoDot:3
if PRCAYES
QUIT
End DoDot:2
if PRCAYES
QUIT
End DoDot:1
+10 SET PRCAF1ST=PRCABTX-10
SET ^XTMP("PRCA399",$JOB,1,0,0)=PRCAF1ST
SET ^PRCA(433,"ZZ1ST")=PRCAF1ST
+11 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 ;D MES^XPDUTL("TOTAL PANDEMIC DEBTOR NON-PANDEMIC BILLS FOUND: "_PRCATB1)
+17 KILL PRCATB1,PRCADB,PRCADBB,PRCABDT
+18 QUIT
USTART ;ASK IF USE TMP GLOBAL OUT OF PRCAMRKC RUN, NEED TO RUN RIGHT AFTER DISCREP RUN
+1 SET PRCAERR=0
+2 READ !,"USE TEMP FILE OUT OF STATEMENT DISCREPANCY RUN? Y/N: ",PRCAX:DTIME
if PRCAX="N"
GOTO U
+3 IF '$DATA(^TMP("PRCAMRKC",$JOB))
WRITE !!,"*** NOTHING IN FILE, MUST SELECT ENTRIES"
GOTO U
+4 GOTO U2
U ;KILL ^TMP("PRCAMARK") AND ASK DEBTOR(S)
+1 KILL ^TMP("PRCAMRKC",$JOB)
U1 FOR I=1:1
SET RCDEBTDA=0
WRITE !!
DO SELECT
if 'RCDEBTDA
GOTO U2
Begin DoDot:1
+1 IF $GET(^RCD(340,RCDEBTDA,0))'[";DPT"
WRITE " ** NOT DEFINED AS PATIENT **"
QUIT
+2 IF '$ORDER(^PRCA(430,"C",RCDEBTDA,0))
WRITE " ** NO BILLS ON FILE FOR DEBTOR **"
QUIT
+3 IF $$REFUREVW^PRCAMRKC(RCDEBTDA)
WRITE " ** REFUND REVIEW DEBTOR **"
+4 SET ^TMP("PRCAMRKC",$JOB,+RCDEBTDA)=""
QUIT
End DoDot:1
U2 SET ^XTMP("PRCA399",$JOB,1,0)=0
+1 READ !,"DO YOU WANT TO SEE COMPLETE DETAIL OF DEBTOR RECALC BILL BY BILL POSTING? Y/N: ",PRCAPRT:20
+2 IF PRCAPRT="Y"
SET ^XTMP("PRCA399",$JOB,1,0)=1
+3 QUIT
SELECT NEW X,Y,DEBT,PRCADB,DA,PRCA,COUNT,OUT,SEL,BILL,BAT,TRAN,DR,DXS
+1 NEW DPTNOFZY,DPTNOFZK
SET (DPTNOFZY,DPTNOFZK)=1
ASK KILL OUT
SET COUNT=0
SET PRCADB=""
SET RCDEPTDA=0
READ !!,"Select DEBTOR NAME or BILL NUMBER: ",X:DTIME
IF $EXTRACT(X)="^"!(X="")
SET RCDEBTDA=0
QUIT
+1 SET X=$$UPPER^VALM1(X)
+2 SET Y=$SELECT($ORDER(^PRCA(430,"B",X,0)):$ORDER(^(0)),$ORDER(^PRCA(430,"D",X,0)):$ORDER(^(0)),1:-1)
+3 IF Y>0
SET DEBT=$PIECE($GET(^PRCA(430,Y,0)),"^",9)
IF DEBT
SET PRCADB=$PIECE($GET(^RCD(340,DEBT,0)),"^")
SET ^DISV(DUZ,"^PRCA(430,")=Y
SET $PIECE(DEBT,"^",2)=$$NAM^RCFN01(DEBT)
+4 SET DIC="^RCD(340,"
SET DIC(0)="E"
DO ^DIC
if Y<0
GOTO ASK
+5 SET ^DISV(DUZ,"^RCD(340,")=+Y
SET PRCADB=$PIECE(Y,"^",2)
SET DEBT=+Y_"^"_$PIECE(@("^"_$PIECE(PRCADB,";",2)_+PRCADB_",0)"),"^")
SET PRCADB=+DEBT
+6 SET ^TMP("PRCAMRKC",$JOB,+PRCADB)=""
SET RCDEBTDA=PRCADB
+7 GOTO ASK
CURTX NEW PRCATX,PRCADTCK
SET PRCADTCK=PRCASETD
+1 FOR
SET PRCADTCK=$ORDER(^PRCA(433,"ATD",PRCADB,PRCADTCK))
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 ;TRANSACTIN 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^^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
