Routine: RCRCALB

RCRCALB ;ALB/CMS - RC FOLLOW-UP ACTION LIST BUILD ; 09-AUG-97

V ;;4.5;Accounts Receivable;**63,159**;Mar 20, 1995

 ;;Per VHA Directive 10-93-142, this routine should not be modified.

EN ; entry point from RCRCAL

 ; Returns: RCSBN,RCSBN(CNT,PRCABN)

 ;      or: RCCAT(catname),RCSI(dbt#),RCSPT,RCSIA,RCSIF,RCSIL,RCSAGN,RCSAGX,RCSAMT,RCSRC,RCDIV(0),RCDIV(40.8#IEN)

 ;      or: RCOUT

 N CNT,DA,DIC,PRCA,PRCABN,RCLQ,RCLQA,RCY,TCNT,T,X,Y

 N RCCNT,RCDIV,RCSD,RCRN,RCSN,RCSNF,RCLCNT,RCSNL,RCSNA,RCSAR,RCSH

 N DIR,DIROUT,DTOUT,DUOUT,DIRUT

 K RCSBN,RCCAT,RCDIV,RCSI,RCSIF,RCSIL,RCSAGN,RCSAGX,RCSAMT,RCSPT,RCSRC,RCOUT

 ;Get Divisions

 D RCDIV^RCRCDIV(.RCDIV)

 ;Select one division if multiple

 I $O(RCDIV(0)) D DIVS^RCRCDIV I $G(RCOUT)=1 G ENQ

 W !!,"Build List of Third Party RC Referrals"

 W !!!

 S DIR("A",1)="Build a list by"

 S DIR("A",2)="1.  Selected AR Third Party Bill(s)"

 S DIR("A",3)="2.  Selected Patient(s)"

 S DIR("A",4)="3.  Selected AR Insurance Debtor(s) or Range"

 S DIR("A",5)="4.  EOB Processing"

 S DIR("A",6)="   "

 S DIR("A")=" Select number: "

 S DIR(0)="SAXB^1:Third Party Bills;2:Patients;3:Insurance Debtors;4:EOB Processing"

 S DIR("B")=1

 D ^DIR

 I $D(DIRUT)!$D(DTOUT)!$D(DUOUT)!$D(DIROUT) S RCOUT=1 G ENQ

 I $E(Y)="^" S RCOUT=1 G ENQ

 S RCRN=Y

 K DIR,DIROUT,DTOUT,DUOUT,DIRUT

 I RCRN=1 D BILL G ENQ

 I RCRN=2 D PT I '$G(RCOUT) D ASK

 I RCRN=3 D INS I '$G(RCOUT) D ASK

 I RCRN=4 D EN^RCRCBL S RCOUT=1

ENQ W !

 I $G(RCOUT)=1 K RCSBN,RCCAT,RCDIV,RCSI,RCSIA,RCSIF,RCSIL,RCSAGN,RCSAGX,RCSPT,RCSAMT,RCSRC

 K DIR,DIROUT,DTOUT,DUOUT,DIRUT

BILL ; - issue prompt for AR Bill Selection(s)

 ; - also called from Modify List Protocol

 N CNT,DIC,DA,RCI,RC1,X,Y,%Y W !

 S DIC("A")="Select Active TP Accounts Receivable Bill No.: "

 S DIC="^PRCA(430,",DIC(0)="AQEMZ"

 S DIC("S")="I $P(^(0),U,8)=16,$P($G(^PRCA(430.2,+$P(^(0),U,2),0)),U,6)=""T"""

 S CNT=0 F  D  Q:($G(PRCABN)<0)!($G(RCOUT))

 .D ^DIC S PRCABN=Y

 .I $G(PRCABN)<0 Q

 .I $G(PRCABN)="^" S RCOUT=1 Q

 .I +$G(RCDIV(0)),'$$DIV^RCRCDIV(PRCABN) W !!,"     <<Bill not in selected division.>>",! Q

 .S CNT=CNT+1,RCSBN=CNT

 .S RCSBN(+PRCABN)=CNT

 .S DIC("A")="Select another Active TP Accounts Receivable Bill No.: "

 .QUIT

 I '$O(RCSBN(0)) S RCOUT=1

 K PRCABN,DIC,DA,X,Y,%Y

BILLQ Q

PT ;  - Issue prompt for Patients

 N DIC,X,Y

 I $O(RCSPT(0)) S DIC("A")="Select another PATIENT: "

 S DIC="^DPT(",DIC(0)="QMEAZ"

 W ! D ^DIC K DIC I $E(Y)="^" S RCOUT=1 G PTQ

 I Y<0,'$O(RCSPT(0)) S RCOUT=1

 I Y<0 G PTQ

 S RCSPT(+Y)=Y G PT

PTQ Q

INS ; - determine range of carriers

 R !!,"Build List for (S)elected Third Party Debtor(s) or a (R)ange: Range// ",X:DTIME

 I ('$T)!(X["^") S RCOUT=1 G INSQ

 S:X="" X="R" S X=$E(X)

 I "SRsr"'[X W !!,?15,"Enter 'S' or 'R' or '^' to exit." G INS

 W $S("sS"[X:"  Selected",1:"  Range") S RCSI=X

 I "Rr"[RCSI G INS1

 S DIC("A")="Select THIRD PARTY AR DEBTOR: "

INSA S DIC="^RCD(340,",DIC(0)="QEAZ",DIC("S")="I $P(^(0),U,1)[""DIC(36,"""

 W ! D ^DIC K DIC I $E(Y)="^" S RCOUT=1 G INSQ

 I Y<0,$O(RCSI(0)) G INSQ

 I Y<0,'$O(RCSI(0)) G INS

 S RCSI(+Y)=Y

 S DIC("A")="Select another THIRD PARTY AR DEBTOR: "

 G INSA

INS1 W !!!,"   START WITH DEBTOR: FIRST// " R X:DTIME

 I ('$T)!(X["^") S RCOUT=1 G INSQ

 I $E(X)="?" W !,?5,"Enter the name of the Insurance Company to start with." G INS1

 S RCSIF=X

INS2 W !,"   GO TO DEBTOR: LAST// " R X:DTIME

 I ('$T)!(X["^") S RCOUT=1 G INSQ

 I $E(X)="?" W !,?5,"Enter the name of the Insurance Company to end with." G INS2

 I X="" S RCSIL="zzzzz" S:RCSIF="" RCSIA="ALL" G INSQ

 I X="@",RCSIF="@" S RCSIL="@",RCSIA="NULL" G INSQ

 I RCSIF'="@",RCSIF]X W *7,!!,"    The LAST value must follow the FIRST.",! G INS1

 S RCSIL=X

INSQ Q

ASK ;Ask optional questions

 ; - Build list for Selected Categories

 N CNT,I,RCCAT,X,Y

 S RCCAT="" D RCCAT^RCRCUTL(.RCCAT)

 S (CNT,X)=0 K DIR

 F  S X=$O(RCCAT(X)) Q:'X  D

 .S CNT=CNT+1 S DIR("A",CNT)=CNT_"  "_$P(RCCAT(X),U,2)

 S TCNT=CNT,CNT=CNT+1,DIR("A",CNT)=" "

 S CNT=CNT+1,DIR("A",CNT)=" "

 S CNT=CNT+1,DIR("A",CNT)=" "

 S DIR("A")=" Enter response: "

 W !!,"AR Categories to Include in Build List"

 W !," Select from the following:",!

 S DIR(0)="L^1:"_TCNT

 D ^DIR I $E(Y)="^" S RCOUT=1 G ASKQ

 K RCCAT F I=1:1:TCNT I $P(Y,",",I) S RCCAT($P(DIR("A",$P(Y,",",I)),"  ",2))=""

 I $D(DIRUT)!$D(DTOUT)!$D(DUOUT)!$D(DIROUT) G ASKQ

 K DIR,DIROUT,DTOUT,DUOUT,DIRUT

ASKQ Q

 ;RCRCALB

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRCRCALB   4490     printed  Feb 18, 2025@23:13:53                                                                                                                                                                                                     Page 2

RCRCALB   ;ALB/CMS - RC FOLLOW-UP ACTION LIST BUILD ; 09-AUG-97

V         ;;4.5;Accounts Receivable;**63,159**;Mar 20, 1995

 +1       ;;Per VHA Directive 10-93-142, this routine should not be modified.

 +2        QUIT

EN        ; entry point from RCRCAL

 +1       ; Returns: RCSBN,RCSBN(CNT,PRCABN)

 +2       ;      or: RCCAT(catname),RCSI(dbt#),RCSPT,RCSIA,RCSIF,RCSIL,RCSAGN,RCSAGX,RCSAMT,RCSRC,RCDIV(0),RCDIV(40.8#IEN)

 +3       ;      or: RCOUT

 +4        NEW CNT,DA,DIC,PRCA,PRCABN,RCLQ,RCLQA,RCY,TCNT,T,X,Y

 +5        NEW RCCNT,RCDIV,RCSD,RCRN,RCSN,RCSNF,RCLCNT,RCSNL,RCSNA,RCSAR,RCSH

 +6        NEW DIR,DIROUT,DTOUT,DUOUT,DIRUT

 +7        KILL RCSBN,RCCAT,RCDIV,RCSI,RCSIF,RCSIL,RCSAGN,RCSAGX,RCSAMT,RCSPT,RCSRC,RCOUT

 +8       ;

 +9       ;Get Divisions

 +10       DO RCDIV^RCRCDIV(.RCDIV)

 +11      ;Select one division if multiple

 +12       IF $ORDER(RCDIV(0))

               DO DIVS^RCRCDIV

               IF $GET(RCOUT)=1

                   GOTO ENQ

 +13      ;

 +14       WRITE !!,"Build List of Third Party RC Referrals"

 +15       WRITE !!!

 +16       SET DIR("A",1)="Build a list by"

 +17       SET DIR("A",2)="1.  Selected AR Third Party Bill(s)"

 +18       SET DIR("A",3)="2.  Selected Patient(s)"

 +19       SET DIR("A",4)="3.  Selected AR Insurance Debtor(s) or Range"

 +20       SET DIR("A",5)="4.  EOB Processing"

 +21       SET DIR("A",6)="   "

 +22       SET DIR("A")=" Select number: "

 +23       SET DIR(0)="SAXB^1:Third Party Bills;2:Patients;3:Insurance Debtors;4:EOB Processing"

 +24       SET DIR("B")=1

 +25       DO ^DIR

 +26       IF $DATA(DIRUT)!$DATA(DTOUT)!$DATA(DUOUT)!$DATA(DIROUT)

               SET RCOUT=1

               GOTO ENQ

 +27       IF $EXTRACT(Y)="^"

               SET RCOUT=1

               GOTO ENQ

 +28       SET RCRN=Y

 +29       KILL DIR,DIROUT,DTOUT,DUOUT,DIRUT

 +30      ;

 +31       IF RCRN=1

               DO BILL

               GOTO ENQ

 +32       IF RCRN=2

               DO PT

               IF '$GET(RCOUT)

                   DO ASK

 +33       IF RCRN=3

               DO INS

               IF '$GET(RCOUT)

                   DO ASK

 +34       IF RCRN=4

               DO EN^RCRCBL

               SET RCOUT=1

ENQ        WRITE !

 +1        IF $GET(RCOUT)=1

               KILL RCSBN,RCCAT,RCDIV,RCSI,RCSIA,RCSIF,RCSIL,RCSAGN,RCSAGX,RCSPT,RCSAMT,RCSRC

 +2        KILL DIR,DIROUT,DTOUT,DUOUT,DIRUT

 +3        QUIT

 +4       ;

 +5       ;

BILL      ; - issue prompt for AR Bill Selection(s)

 +1       ; - also called from Modify List Protocol

 +2        NEW CNT,DIC,DA,RCI,RC1,X,Y,%Y

           WRITE !

 +3        SET DIC("A")="Select Active TP Accounts Receivable Bill No.: "

 +4        SET DIC="^PRCA(430,"

           SET DIC(0)="AQEMZ"

 +5        SET DIC("S")="I $P(^(0),U,8)=16,$P($G(^PRCA(430.2,+$P(^(0),U,2),0)),U,6)=""T"""

 +6        SET CNT=0

FOR

               Begin DoDot:1

 +7                DO ^DIC

                   SET PRCABN=Y

 +8                IF $GET(PRCABN)<0

                       QUIT

 +9                IF $GET(PRCABN)="^"

                       SET RCOUT=1

                       QUIT

 +10               IF +$GET(RCDIV(0))

                       IF '$$DIV^RCRCDIV(PRCABN)

                           WRITE !!,"     <<Bill not in selected division.>>",!

                           QUIT

 +11               SET CNT=CNT+1

                   SET RCSBN=CNT

 +12               SET RCSBN(+PRCABN)=CNT

 +13               SET DIC("A")="Select another Active TP Accounts Receivable Bill No.: "

 +14               QUIT

               End DoDot:1

               if ($GET(PRCABN)<0)!($GET(RCOUT))

                   QUIT

 +15       IF '$ORDER(RCSBN(0))

               SET RCOUT=1

 +16       KILL PRCABN,DIC,DA,X,Y,%Y

BILLQ      QUIT

 +1       ;

PT        ;  - Issue prompt for Patients

 +1        NEW DIC,X,Y

 +2        IF $ORDER(RCSPT(0))

               SET DIC("A")="Select another PATIENT: "

 +3        SET DIC="^DPT("

           SET DIC(0)="QMEAZ"

 +4        WRITE !

           DO ^DIC

           KILL DIC

           IF $EXTRACT(Y)="^"

               SET RCOUT=1

               GOTO PTQ

 +5        IF Y<0

               IF '$ORDER(RCSPT(0))

                   SET RCOUT=1

 +6        IF Y<0

               GOTO PTQ

 +7        SET RCSPT(+Y)=Y

           GOTO PT

PTQ        QUIT

 +1       ;

INS       ; - determine range of carriers

 +1        READ !!,"Build List for (S)elected Third Party Debtor(s) or a (R)ange: Range// ",X:DTIME

 +2        IF ('$TEST)!(X["^")

               SET RCOUT=1

               GOTO INSQ

 +3        if X=""

               SET X="R"

           SET X=$EXTRACT(X)

 +4        IF "SRsr"'[X

               WRITE !!,?15,"Enter 'S' or 'R' or '^' to exit."

               GOTO INS

 +5        WRITE $SELECT("sS"[X:"  Selected",1:"  Range")

           SET RCSI=X

 +6        IF "Rr"[RCSI

               GOTO INS1

 +7       ;

 +8        SET DIC("A")="Select THIRD PARTY AR DEBTOR: "

INSA       SET DIC="^RCD(340,"

           SET DIC(0)="QEAZ"

           SET DIC("S")="I $P(^(0),U,1)[""DIC(36,"""

 +1        WRITE !

           DO ^DIC

           KILL DIC

           IF $EXTRACT(Y)="^"

               SET RCOUT=1

               GOTO INSQ

 +2        IF Y<0

               IF $ORDER(RCSI(0))

                   GOTO INSQ

 +3        IF Y<0

               IF '$ORDER(RCSI(0))

                   GOTO INS

 +4        SET RCSI(+Y)=Y

 +5        SET DIC("A")="Select another THIRD PARTY AR DEBTOR: "

 +6        GOTO INSA

 +7       ;

INS1       WRITE !!!,"   START WITH DEBTOR: FIRST// "

           READ X:DTIME

 +1        IF ('$TEST)!(X["^")

               SET RCOUT=1

               GOTO INSQ

 +2        IF $EXTRACT(X)="?"

               WRITE !,?5,"Enter the name of the Insurance Company to start with."

               GOTO INS1

 +3        SET RCSIF=X

INS2       WRITE !,"   GO TO DEBTOR: LAST// "

           READ X:DTIME

 +1        IF ('$TEST)!(X["^")

               SET RCOUT=1

               GOTO INSQ

 +2        IF $EXTRACT(X)="?"

               WRITE !,?5,"Enter the name of the Insurance Company to end with."

               GOTO INS2

 +3        IF X=""

               SET RCSIL="zzzzz"

               if RCSIF=""

                   SET RCSIA="ALL"

               GOTO INSQ

 +4        IF X="@"

               IF RCSIF="@"

                   SET RCSIL="@"

                   SET RCSIA="NULL"

                   GOTO INSQ

 +5        IF RCSIF'="@"

               IF RCSIF]X

                   WRITE *7,!!,"    The LAST value must follow the FIRST.",!

                   GOTO INS1

 +6        SET RCSIL=X

INSQ       QUIT

 +1       ;

ASK       ;Ask optional questions

 +1       ;

 +2       ; - Build list for Selected Categories

 +3        NEW CNT,I,RCCAT,X,Y

 +4        SET RCCAT=""

           DO RCCAT^RCRCUTL(.RCCAT)

 +5        SET (CNT,X)=0

           KILL DIR

 +6        FOR

               SET X=$ORDER(RCCAT(X))

               if 'X

                   QUIT

               Begin DoDot:1

 +7                SET CNT=CNT+1

                   SET DIR("A",CNT)=CNT_"  "_$PIECE(RCCAT(X),U,2)

               End DoDot:1

 +8        SET TCNT=CNT

           SET CNT=CNT+1

           SET DIR("A",CNT)=" "

 +9        SET CNT=CNT+1

           SET DIR("A",CNT)=" "

 +10       SET CNT=CNT+1

           SET DIR("A",CNT)=" "

 +11       SET DIR("A")=" Enter response: "

 +12       WRITE !!,"AR Categories to Include in Build List"

 +13       WRITE !," Select from the following:",!

 +14       SET DIR(0)="L^1:"_TCNT

 +15       DO ^DIR

           IF $EXTRACT(Y)="^"

               SET RCOUT=1

               GOTO ASKQ

 +16       KILL RCCAT

           FOR I=1:1:TCNT

               IF $PIECE(Y,",",I)

                   SET RCCAT($PIECE(DIR("A",$PIECE(Y,",",I)),"  ",2))=""

 +17       IF $DATA(DIRUT)!$DATA(DTOUT)!$DATA(DUOUT)!$DATA(DIROUT)

               GOTO ASKQ

 +18       KILL DIR,DIROUT,DTOUT,DUOUT,DIRUT

 +19      ;

ASKQ       QUIT

 +1       ;RCRCALB

RCRCALB.m