- 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 Feb 18, 2025@23:10:15 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
