PRCA399B ;MNTVBB/RCB - RESET BILL NODE DEPENDING ON: TRANACTIONS & 382/385 ISSUES ; 2/23/22
;;4.5;Accounts Receivable;**399**;Feb 05, 2022;Build 67
;;Per VA Directive 6402, this routine should not be modified.
Q
EN W:PRCAW !,"MANUAL POST!!"
I PRCATXN>0 D
.S ^XTMP("PRCA399",$J,6,1,PRCABILL,PRCATX,PRCATXN,1)=@("PRCATX"_PRCATXN)
.S PRCAT238=PRCAT238_U_"FLIP"
I PRCACD D
.;K ^XTMP("PRCA399",$J,1,1,PRCABILL,9,PRCATX,4)
.I PRCACMTH="ZZ" S ^XTMP("PRCA399",$J,2,2,PRCACD,PRCABILL,PRCATX)=PRCATXR_" ***NO FACTOR***" Q
1 .I PRCACD=1,PRCAPPAY D
..I '$D(^XTMP("PRCA399",$J,1,1,PRCABILL,11)) S ^XTMP("PRCA399",$J,1,1,PRCABILL,11)=0
..S ^XTMP("PRCA399",$J,1,1,PRCABILL,11)=^XTMP("PRCA399",$J,1,1,PRCABILL,11)+PRCATXDL,PRCAP(1)=PRCATXDL
11 .I PRCACD=1,'PRCAPPAY S PRCAP(1)=PRCAP(1)+PRCATXDL
23 .I PRCACD=23 D
..F I=1:1:3 S PRCAP(I)=0,PRCAS(I+5)=0 S:I=1 PRCAP(I)=PRCATXDL
79 .I ";79;80;"[(";"_PRCACD_";") S PRCAP(1)=PRCAP(1)+PRCATXDL
43 .I PRCACD=43 S PRCAP(1)=PRCAP(1)+PRCATXDL,$P(PRCAT238,U)=PRCATXDL
73 .I PRCACD=73 S PRCAP(1)=PRCAP(1)+PRCATXDL
46 .I PRCACD=46 F I=1:1:3 S PRCAP(I)=$P(PRCATX8,U,I),$P(PRCAT238,U,I)=$P(PRCATX8,U,I)
47 .I PRCACD=47 F I=1:1:3 S PRCAP(I)=PRCAP(I)-PRCATX8(I),$P(PRCAT238,U,I)=$P(PRCATX8,U,I) ;26;41;
10 .I ";8;9;10;11;"[(";"_PRCACD_";") D
..F I=2,3,1 S PRCAAMT=$S(PRCATXDL'>PRCAP(I):PRCATXDL,1:PRCAP(1)) S PRCAP(I)=PRCAP(I)-PRCAAMT,PRCAS(I)=PRCAS(I)+PRCAAMT,$P(PRCAT238,U,I)=PRCAAMT,PRCATXDL=PRCATXDL-PRCAAMT Q:'PRCATXDL
..S:PRCATXDL ^XTMP("PRCA399",$J,1,1,PRCABILL,9,PRCATX,2)=PRCACD_U_PRCATXDL,PRCANEG=PRCATXDL_U_PRCACD
12 .I ";12;13;74;"[(";"_PRCACD_";") D
..S PRCADOLI=$P(PRCATX2,U,2),PRCADOLA=$P(PRCATX2,U,3)
..S PRCAP(2)=PRCAP(2)+PRCADOLI,PRCAP(3)=PRCAP(3)+PRCADOLA F I=2,3 S $P(PRCAT238,U,I)=$P(PRCATX2,U,I)
14 .I ";14;"[(";"_PRCACD_";") D
..F I=2,3,1 D Q:'PRCATXDL
...S PRCAAMT=$S(PRCAP(I)'>PRCATXDL:PRCAP(I),1:PRCATXDL)
...S PRCAP(I)=PRCAP(I)-PRCAAMT,PRCAS(I)=PRCAS(I)+PRCAAMT,$P(PRCAT238,U,I)=PRCAAMT
...S PRCATXDL=PRCATXDL-PRCAAMT
..S:PRCATXDL ^XTMP("PRCA399",$J,1,1,PRCABILL,9,PRCATX,2)=PRCACD_U_PRCATXDL,PRCANEG=PRCATXDL_U_PRCACD
26 .I ";39;70;26;41;"[(";"_PRCACD_";") D
..S PRCAAMT=$S(PRCAP(1)'>PRCATXDL:PRCAP(1),1:PRCATXDL) S PRCAP(1)=PRCAP(1)-PRCAAMT,PRCAS(1)=PRCAS(1)+PRCAAMT,PRCATXDL=PRCATXDL-PRCAAMT Q:'PRCATXDL
..S:PRCATXDL ^XTMP("PRCA399",$J,1,1,PRCABILL,9,PRCATX,3)=PRCATXDL_U_PRCACD,PRCANEG=PRCATXDL_U_PRCACD
2 .I ";2;34;35;"[(";"_PRCACD_";") D
..F I=2,3,1 S PRCAAMT=$S(PRCATXDL'>PRCAP(I):PRCATXDL,1:PRCAP(I)) S PRCAP(I)=PRCAP(I)-PRCAAMT,PRCAS(I)=PRCAS(I)+PRCAAMT,$P(PRCAT238,U,I)=PRCAAMT,PRCATXDL=PRCATXDL-PRCAAMT Q:'PRCATXDL
..I PRCATXDL>0 S ^XTMP("PRCA399",$J,1,1,PRCABILL,9,PRCATXH,3,"9C1")=PRCATXDL,PRCAPRPY=PRCATXDL_U_PRCACD W:PRCAW !,"PREPAY DETERMINED: ",PRCATXDL," FOR PRCABILL: ",$P(PRCAR,U) R:'PRCAYY&PRCAW PRCAYY:10
I PRCATXN D
.W:PRCAW !,@("PRCATX"_PRCATXN),?45,PRCAT238
.S ^XTMP("PRCA399",$J,1,1,PRCABILL,9,PRCATX,2,$P(PRCAT238,U,4))=PRCAT238_U_PRCATXDL
Q
;
CHKRUN ;
100 S U="^",(PRCAT,PRCAT1,PRCAT2,PRCAT3)=0,PRCADBTR=0
F S PRCABILL=$O(^XTMP("PRCA399",$J,2,2,PRCADBTR)),PRCABILL=0 Q:'PRCADBTR D
. F S PRCABILL=$O(^XTMP("PRCA399",$J,2,2,PRCADBTR,1,PRCABILL)) Q:'PRCABILL S PRCAT=PRCAT+1 D
.. S PRCAR1=^XTMP("PRCA399",$J,2,2,PRCADBTR,1,PRCABILL,1),PRCAR2=^XTMP("PRCA399",$J,2,2,PRCADBTR,1,PRCABILL,2)
.. I $P(PRCAR1,U,1,5)'=$P(PRCAR2,U,1,5) S PRCAT1=PRCAT1+1
.. I PRCAR1'=PRCAR2 S PRCAT2=PRCAT2+1 I $P(PRCAR1,U,1,5)=$P(PRCAR2,U,1,5),$P(PRCAR1,U,7,11)="" S PRCAT3=PRCAT3+1
W !!,"OVERALL PANDEMIC EXEMPTED PRCABILLS ",PRCAT
W !,"NON MATCH FOR NODE 7 DEBIT TOTALS: ",PRCAT1
W !,"TOTAL MISMATCH FOR NODE 7 AND REBUILD: ",PRCAT2
W !,"TOTAL MISMATCH DUE TO NO NODE7 CREDITS: ",PRCAT3
K PRCAT,PRCAT1,PRCAT2,PRCAT3,PRCABILL
Q
110 ;DISPLAY NEW RESULT ON ACTIVITY.
S U="^",(PRCAT,PRCAT1,PRCAT2,PRCAT3,XX)=0 W !
F S PRCADBTR=$O(^XTMP("PRCA399",$J,2,2,PRCADBTR)),PRCABILL=0 Q:'PRCADBTR D
. F S PRCABILL=$O(^XTMP("PRCA399",$J,2,2,PRCADBTR,1,PRCABILL)),PRCATX=0 Q:'PRCABILL D
.. F S PRCATX=$O(^XTMP("PRCA399",$J,1,PRCABILL,9,PRCATX)) Q:'PRCATX D
... I '$D(^XTMP("PRCA399",$J,1,PRCABILL,9,PRCATX,3)) Q
... W !!,PRCABILL,?12,$P(^PRCA(430,PRCABILL,0),U) D R:'PRCAXX PRCAXX:10
.... F I=0:1:4,6:1:8 I $D(^PRCA(433,PRCATX,I)) W !,?10,"NODE ",I,": ",^PRCA(433,PRCATX,I)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRCA399B 4382 printed Jul 11, 2026@01:35:27 Page 2
PRCA399B ;MNTVBB/RCB - RESET BILL NODE DEPENDING ON: TRANACTIONS & 382/385 ISSUES ; 2/23/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 if PRCAW
WRITE !,"MANUAL POST!!"
+1 IF PRCATXN>0
Begin DoDot:1
+2 SET ^XTMP("PRCA399",$JOB,6,1,PRCABILL,PRCATX,PRCATXN,1)=@("PRCATX"_PRCATXN)
+3 SET PRCAT238=PRCAT238_U_"FLIP"
End DoDot:1
+4 IF PRCACD
Begin DoDot:1
+5 ;K ^XTMP("PRCA399",$J,1,1,PRCABILL,9,PRCATX,4)
+6 IF PRCACMTH="ZZ"
SET ^XTMP("PRCA399",$JOB,2,2,PRCACD,PRCABILL,PRCATX)=PRCATXR_" ***NO FACTOR***"
QUIT
1 IF PRCACD=1
IF PRCAPPAY
Begin DoDot:2
+1 IF '$DATA(^XTMP("PRCA399",$JOB,1,1,PRCABILL,11))
SET ^XTMP("PRCA399",$JOB,1,1,PRCABILL,11)=0
+2 SET ^XTMP("PRCA399",$JOB,1,1,PRCABILL,11)=^XTMP("PRCA399",$JOB,1,1,PRCABILL,11)+PRCATXDL
SET PRCAP(1)=PRCATXDL
End DoDot:2
11 IF PRCACD=1
IF 'PRCAPPAY
SET PRCAP(1)=PRCAP(1)+PRCATXDL
23 IF PRCACD=23
Begin DoDot:2
+1 FOR I=1:1:3
SET PRCAP(I)=0
SET PRCAS(I+5)=0
if I=1
SET PRCAP(I)=PRCATXDL
End DoDot:2
79 IF ";79;80;"[(";"_PRCACD_";")
SET PRCAP(1)=PRCAP(1)+PRCATXDL
43 IF PRCACD=43
SET PRCAP(1)=PRCAP(1)+PRCATXDL
SET $PIECE(PRCAT238,U)=PRCATXDL
73 IF PRCACD=73
SET PRCAP(1)=PRCAP(1)+PRCATXDL
46 IF PRCACD=46
FOR I=1:1:3
SET PRCAP(I)=$PIECE(PRCATX8,U,I)
SET $PIECE(PRCAT238,U,I)=$PIECE(PRCATX8,U,I)
47 ;26;41;
IF PRCACD=47
FOR I=1:1:3
SET PRCAP(I)=PRCAP(I)-PRCATX8(I)
SET $PIECE(PRCAT238,U,I)=$PIECE(PRCATX8,U,I)
10 IF ";8;9;10;11;"[(";"_PRCACD_";")
Begin DoDot:2
+1 FOR I=2,3,1
SET PRCAAMT=$SELECT(PRCATXDL'>PRCAP(I):PRCATXDL,1:PRCAP(1))
SET PRCAP(I)=PRCAP(I)-PRCAAMT
SET PRCAS(I)=PRCAS(I)+PRCAAMT
SET $PIECE(PRCAT238,U,I)=PRCAAMT
SET PRCATXDL=PRCATXDL-PRCAAMT
if 'PRCATXDL
QUIT
+2 if PRCATXDL
SET ^XTMP("PRCA399",$JOB,1,1,PRCABILL,9,PRCATX,2)=PRCACD_U_PRCATXDL
SET PRCANEG=PRCATXDL_U_PRCACD
End DoDot:2
12 IF ";12;13;74;"[(";"_PRCACD_";")
Begin DoDot:2
+1 SET PRCADOLI=$PIECE(PRCATX2,U,2)
SET PRCADOLA=$PIECE(PRCATX2,U,3)
+2 SET PRCAP(2)=PRCAP(2)+PRCADOLI
SET PRCAP(3)=PRCAP(3)+PRCADOLA
FOR I=2,3
SET $PIECE(PRCAT238,U,I)=$PIECE(PRCATX2,U,I)
End DoDot:2
14 IF ";14;"[(";"_PRCACD_";")
Begin DoDot:2
+1 FOR I=2,3,1
Begin DoDot:3
+2 SET PRCAAMT=$SELECT(PRCAP(I)'>PRCATXDL:PRCAP(I),1:PRCATXDL)
+3 SET PRCAP(I)=PRCAP(I)-PRCAAMT
SET PRCAS(I)=PRCAS(I)+PRCAAMT
SET $PIECE(PRCAT238,U,I)=PRCAAMT
+4 SET PRCATXDL=PRCATXDL-PRCAAMT
End DoDot:3
if 'PRCATXDL
QUIT
+5 if PRCATXDL
SET ^XTMP("PRCA399",$JOB,1,1,PRCABILL,9,PRCATX,2)=PRCACD_U_PRCATXDL
SET PRCANEG=PRCATXDL_U_PRCACD
End DoDot:2
26 IF ";39;70;26;41;"[(";"_PRCACD_";")
Begin DoDot:2
+1 SET PRCAAMT=$SELECT(PRCAP(1)'>PRCATXDL:PRCAP(1),1:PRCATXDL)
SET PRCAP(1)=PRCAP(1)-PRCAAMT
SET PRCAS(1)=PRCAS(1)+PRCAAMT
SET PRCATXDL=PRCATXDL-PRCAAMT
if 'PRCATXDL
QUIT
+2 if PRCATXDL
SET ^XTMP("PRCA399",$JOB,1,1,PRCABILL,9,PRCATX,3)=PRCATXDL_U_PRCACD
SET PRCANEG=PRCATXDL_U_PRCACD
End DoDot:2
2 IF ";2;34;35;"[(";"_PRCACD_";")
Begin DoDot:2
+1 FOR I=2,3,1
SET PRCAAMT=$SELECT(PRCATXDL'>PRCAP(I):PRCATXDL,1:PRCAP(I))
SET PRCAP(I)=PRCAP(I)-PRCAAMT
SET PRCAS(I)=PRCAS(I)+PRCAAMT
SET $PIECE(PRCAT238,U,I)=PRCAAMT
SET PRCATXDL=PRCATXDL-PRCAAMT
if 'PRCATXDL
QUIT
+2 IF PRCATXDL>0
SET ^XTMP("PRCA399",$JOB,1,1,PRCABILL,9,PRCATXH,3,"9C1")=PRCATXDL
SET PRCAPRPY=PRCATXDL_U_PRCACD
if PRCAW
WRITE !,"PREPAY DETERMINED: ",PRCATXDL," FOR PRCABILL: ",$PIECE(PRCAR,U)
if 'PRCAYY&PRCAW
READ PRCAYY:10
End DoDot:2
End DoDot:1
+3 IF PRCATXN
Begin DoDot:1
+4 if PRCAW
WRITE !,@("PRCATX"_PRCATXN),?45,PRCAT238
+5 SET ^XTMP("PRCA399",$JOB,1,1,PRCABILL,9,PRCATX,2,$PIECE(PRCAT238,U,4))=PRCAT238_U_PRCATXDL
End DoDot:1
+6 QUIT
+7 ;
CHKRUN ;
100 SET U="^"
SET (PRCAT,PRCAT1,PRCAT2,PRCAT3)=0
SET PRCADBTR=0
+1 FOR
SET PRCABILL=$ORDER(^XTMP("PRCA399",$JOB,2,2,PRCADBTR))
SET PRCABILL=0
if 'PRCADBTR
QUIT
Begin DoDot:1
+2 FOR
SET PRCABILL=$ORDER(^XTMP("PRCA399",$JOB,2,2,PRCADBTR,1,PRCABILL))
if 'PRCABILL
QUIT
SET PRCAT=PRCAT+1
Begin DoDot:2
+3 SET PRCAR1=^XTMP("PRCA399",$JOB,2,2,PRCADBTR,1,PRCABILL,1)
SET PRCAR2=^XTMP("PRCA399",$JOB,2,2,PRCADBTR,1,PRCABILL,2)
+4 IF $PIECE(PRCAR1,U,1,5)'=$PIECE(PRCAR2,U,1,5)
SET PRCAT1=PRCAT1+1
+5 IF PRCAR1'=PRCAR2
SET PRCAT2=PRCAT2+1
IF $PIECE(PRCAR1,U,1,5)=$PIECE(PRCAR2,U,1,5)
IF $PIECE(PRCAR1,U,7,11)=""
SET PRCAT3=PRCAT3+1
End DoDot:2
End DoDot:1
+6 WRITE !!,"OVERALL PANDEMIC EXEMPTED PRCABILLS ",PRCAT
+7 WRITE !,"NON MATCH FOR NODE 7 DEBIT TOTALS: ",PRCAT1
+8 WRITE !,"TOTAL MISMATCH FOR NODE 7 AND REBUILD: ",PRCAT2
+9 WRITE !,"TOTAL MISMATCH DUE TO NO NODE7 CREDITS: ",PRCAT3
+10 KILL PRCAT,PRCAT1,PRCAT2,PRCAT3,PRCABILL
+11 QUIT
110 ;DISPLAY NEW RESULT ON ACTIVITY.
+1 SET U="^"
SET (PRCAT,PRCAT1,PRCAT2,PRCAT3,XX)=0
WRITE !
+2 FOR
SET PRCADBTR=$ORDER(^XTMP("PRCA399",$JOB,2,2,PRCADBTR))
SET PRCABILL=0
if 'PRCADBTR
QUIT
Begin DoDot:1
+3 FOR
SET PRCABILL=$ORDER(^XTMP("PRCA399",$JOB,2,2,PRCADBTR,1,PRCABILL))
SET PRCATX=0
if 'PRCABILL
QUIT
Begin DoDot:2
+4 FOR
SET PRCATX=$ORDER(^XTMP("PRCA399",$JOB,1,PRCABILL,9,PRCATX))
if 'PRCATX
QUIT
Begin DoDot:3
+5 IF '$DATA(^XTMP("PRCA399",$JOB,1,PRCABILL,9,PRCATX,3))
QUIT
+6 WRITE !!,PRCABILL,?12,$PIECE(^PRCA(430,PRCABILL,0),U)
Begin DoDot:4
+7 FOR I=0:1:4,6:1:8
IF $DATA(^PRCA(433,PRCATX,I))
WRITE !,?10,"NODE ",I,": ",^PRCA(433,PRCATX,I)
End DoDot:4
if 'PRCAXX
READ PRCAXX:10
End DoDot:3
End DoDot:2
End DoDot:1
+8 QUIT
