RCDPARC1.m

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 ---RCDPARC1   2109     printed  Apr 09, 2024@20:46:54                                                                                                                                                                                                    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