RCDPARC1 ;AITC/CJE - CARC REPORT ON PAYER OR CARC CODE ;9/15/14 3:00pm
;;4.5;Accounts Receivable;**326**;Mar 20, 1995;Build 26
;;Per VA Directive 6402, this routine should not be modified.
Q
;
SORT(ARRAY,SORT) ; Sort and summarize data based on SORT variable
N CARC,IEN,D1,D2,PIEN,PAYER,Z,TIN,DESC,R1,BILL S IEN=""
; IEN= IEN from file 361.1; PIEN= 835 Payer IEN from file 344.6
F S IEN=$O(@ARRAY@("BILLS",IEN)) Q:IEN="" D
. S D1=@ARRAY@("BILLS",IEN,0),TIN=$P(D1,U,5),BILL=$P(D1,U,2)
. S PAYER=$$GPAYR^RCDPRU2(TIN) Q:$G(PAYER)="" ; couldn't find a payer to match TIN, quit
. S CARC="",Z="",R1=""
. F S Z=$O(@ARRAY@("BILLS",IEN,"C",Z)) Q:Z="" S D2=@ARRAY@("BILLS",IEN,"C",Z),CARC=$P(D2,U,1),DESC=$P(D2,U,4) D
.. ; If RARC exists append to CARC Information
.. S:$G(@ARRAY@("BILLS",IEN,"R",Z))'="" R1=@ARRAY@("BILLS",IEN,"R",Z)
.. ;W "RARC: |",$G(@ARRAY@("BILLS",IEN,"R",Z)),"|",!
.. D:SORT="C" ; Sort by CARC, group by Payer
... S @ARRAY@("REPORT",CARC,PAYER_"/"_TIN,IEN,0)=D1
... ; First time through set the "BILLS" D2 into report, otherwise add adjustment amt to the existing for this CARC
... I $G(@ARRAY@("REPORT",CARC,PAYER_"/"_TIN,IEN,1))="" S @ARRAY@("REPORT",CARC,PAYER_"/"_TIN,IEN,1)=D2_U_R1
... E S $P(@ARRAY@("REPORT",CARC,PAYER_"/"_TIN,IEN,1),U,2)=$P(@ARRAY@("REPORT",CARC,PAYER_"/"_TIN,IEN,1),U,2)+$P(D2,U,2) ;W "CARC: ",CARC," Bill: ",BILL," D2: ",D2,!
.. D:SORT="P" ; Sort by Payer, group by CARC
... S @ARRAY@("REPORT",PAYER_"/"_TIN,CARC,IEN,0)=D1
... ; First time through set the "BILLS" D2 into report, otherwise add adjustment amt to the existing for this CARC
... I $G(@ARRAY@("REPORT",PAYER_"/"_TIN,CARC,IEN,1))="" S @ARRAY@("REPORT",PAYER_"/"_TIN,CARC,IEN,1)=D2_U_R1
... E S $P(@ARRAY@("REPORT",PAYER_"/"_TIN,CARC,IEN,1),U,2)=$P(@ARRAY@("REPORT",PAYER_"/"_TIN,CARC,IEN,1),U,2)+$P(D2,U,2)
.. ;I CARC=1 W ARRAY," BILL:",BILL," CARC:",CARC," ",PAYER_"/"_TIN," ",$P(D1,U,6)," ",$P(D1,U,7)," ",DESC," ",$P(D2,U,2)," ",SORT,!
.. D SUM^RCDPRU2(ARRAY,IEN,BILL,CARC,PAYER_"/"_TIN,$P(D1,U,6),$P(D1,U,7),DESC,$P(D2,U,2),SORT)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRCDPARC1 2109 printed Dec 13, 2024@01:43:52 Page 2
RCDPARC1 ;AITC/CJE - CARC REPORT ON PAYER OR CARC CODE ;9/15/14 3:00pm
+1 ;;4.5;Accounts Receivable;**326**;Mar 20, 1995;Build 26
+2 ;;Per VA Directive 6402, this routine should not be modified.
+3 QUIT
+4 ;
SORT(ARRAY,SORT) ; Sort and summarize data based on SORT variable
+1 NEW CARC,IEN,D1,D2,PIEN,PAYER,Z,TIN,DESC,R1,BILL
SET IEN=""
+2 ; IEN= IEN from file 361.1; PIEN= 835 Payer IEN from file 344.6
+3 FOR
SET IEN=$ORDER(@ARRAY@("BILLS",IEN))
if IEN=""
QUIT
Begin DoDot:1
+4 SET D1=@ARRAY@("BILLS",IEN,0)
SET TIN=$PIECE(D1,U,5)
SET BILL=$PIECE(D1,U,2)
+5 ; couldn't find a payer to match TIN, quit
SET PAYER=$$GPAYR^RCDPRU2(TIN)
if $GET(PAYER)=""
QUIT
+6 SET CARC=""
SET Z=""
SET R1=""
+7 FOR
SET Z=$ORDER(@ARRAY@("BILLS",IEN,"C",Z))
if Z=""
QUIT
SET D2=@ARRAY@("BILLS",IEN,"C",Z)
SET CARC=$PIECE(D2,U,1)
SET DESC=$PIECE(D2,U,4)
Begin DoDot:2
+8 ; If RARC exists append to CARC Information
+9 if $GET(@ARRAY@("BILLS",IEN,"R",Z))'=""
SET R1=@ARRAY@("BILLS",IEN,"R",Z)
+10 ;W "RARC: |",$G(@ARRAY@("BILLS",IEN,"R",Z)),"|",!
+11 ; Sort by CARC, group by Payer
if SORT="C"
Begin DoDot:3
+12 SET @ARRAY@("REPORT",CARC,PAYER_"/"_TIN,IEN,0)=D1
+13 ; First time through set the "BILLS" D2 into report, otherwise add adjustment amt to the existing for this CARC
+14 IF $GET(@ARRAY@("REPORT",CARC,PAYER_"/"_TIN,IEN,1))=""
SET @ARRAY@("REPORT",CARC,PAYER_"/"_TIN,IEN,1)=D2_U_R1
+15 ;W "CARC: ",CARC," Bill: ",BILL," D2: ",D2,!
IF '$TEST
SET $PIECE(@ARRAY@("REPORT",CARC,PAYER_"/"_TIN,IEN,1),U,2)=$PIECE(@ARRAY@("REPORT",CARC,PAYER_"/"_TIN,IEN,1),U,2)+$PIECE(D2,U,2)
End DoDot:3
+16 ; Sort by Payer, group by CARC
if SORT="P"
Begin DoDot:3
+17 SET @ARRAY@("REPORT",PAYER_"/"_TIN,CARC,IEN,0)=D1
+18 ; First time through set the "BILLS" D2 into report, otherwise add adjustment amt to the existing for this CARC
+19 IF $GET(@ARRAY@("REPORT",PAYER_"/"_TIN,CARC,IEN,1))=""
SET @ARRAY@("REPORT",PAYER_"/"_TIN,CARC,IEN,1)=D2_U_R1
+20 IF '$TEST
SET $PIECE(@ARRAY@("REPORT",PAYER_"/"_TIN,CARC,IEN,1),U,2)=$PIECE(@ARRAY@("REPORT",PAYER_"/"_TIN,CARC,IEN,1),U,2)+$PIECE(D2,U,2)
End DoDot:3
+21 ;I CARC=1 W ARRAY," BILL:",BILL," CARC:",CARC," ",PAYER_"/"_TIN," ",$P(D1,U,6)," ",$P(D1,U,7)," ",DESC," ",$P(D2,U,2)," ",SORT,!
+22 DO SUM^RCDPRU2(ARRAY,IEN,BILL,CARC,PAYER_"/"_TIN,$PIECE(D1,U,6),$PIECE(D1,U,7),DESC,$PIECE(D2,U,2),SORT)
End DoDot:2
End DoDot:1
+23 QUIT
