Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: RCRCVLB

RCRCVLB.m

Go to the documentation of this file. 
  1. RCRCVLB ;ALB/CMS - RC VIEW ACTIVE LIST BUILD ; 09-AUG-97
  1. V ;;4.5;Accounts Receivable;**63,159**;Mar 20, 1995
  1.  ;;Per VHA Directive 10-93-142, this routine should not be modified.
  1.  Q
  1. EN ; entry point from RCRCVL
  1.  ; Returns: RCSBN,RCSBN(CNT,PRCABN)
  1.  ;      or: RCCAT(catname),RCSI(dbt#),RCSPT,RCSIA,RCSIF,RCSIL,RCSAGN,RCSAGX,RCSAMT,RCSRC
  1.  ;      or: if muti-divisions RCDIV(0),RCDIV(selected 40.8IEN)
  1.  ;      or: RCOUT
  1.  N CNT,DA,DIC,PRCA,PRCABN,RCLQ,RCLQA,RCY,RCS,TCNT,T,X,Y
  1.  N RCDIV,RCCNT,RCSD,RCRN,RCSN,RCSNF,RCLCNT,RCSNL,RCSNA,RCSAR,RCSH
  1.  N DIR,DIROUT,DTOUT,DUOUT,DIRUT
  1.  K RCSBN,RCCAT,RCSI,RCSIF,RCSIL,RCSAGN,RCSAGX,RCSAMT,RCSPT,RCSRC,RCOUT
  1.  ;
  1.  ;Get Divisions
  1.  D RCDIV^RCRCDIV(.RCDIV)
  1.  ;Select one division if multiple
  1.  I $O(RCDIV(0)) D DIVS^RCRCDIV I $G(RCOUT)=1 G ENQ
  1.  ;
  1.  W !!,"Build List of Possible Third Party Referrals"
  1.  S DIR("A",1)="Build a list by"
  1.  S DIR("A",2)="1.  Selected AR Third Party Bill(s)"
  1.  S DIR("A",3)="2.  Selected Patient(s)"
  1.  S DIR("A",4)="3.  Selected AR Insurance Debtor(s) or"
  1.  S DIR("A",5)="               Insurance Range"
  1.  S DIR("A",6)=" "
  1.  S DIR("A")=" Select Number: "
  1.  S DIR(0)="SAXB^1:Third Party Bills;2:Patients;3:Insurance Debtors"
  1.  S DIR("B")=1
  1.  D ^DIR I $D(DIRUT)!$D(DTOUT)!$D(DUOUT)!$D(DIROUT) S RCOUT=1 G ENQ
  1.  I $E(Y)="^" S RCOUT=1 G ENQ
  1.  S RCRN=Y
  1.  K DIR,DIROUT,DTOUT,DUOUT,DIRUT
  1.  ;
  1.  I RCRN=1 D BILL G ENQ
  1.  I RCRN=2 D PT I '$G(RCOUT) D ASK
  1.  I RCRN=3 D INS I '$G(RCOUT) D ASK
  1. ENQ W !
  1.  I $G(RCOUT)=1 K RCSBN,RCCAT,RCDIV,RCSI,RCSIA,RCSIF,RCSIL,RCSAGN,RCSAGX,RCSPT,RCSAMT,RCSRC
  1.  K DIR,DIROUT,DTOUT,DUOUT,DIRUT
  1.  Q
  1.  ;
  1.  ;
  1. BILL ; - issue prompt for AR Bill Selection(s)
  1.  ; - also called from Modify List Protocol
  1.  K DIC,DA,X,Y,%Y W !
  1.  S DIC("A")="Select Active TP Accounts Receivable Bill No.: "
  1.  S DIC="^PRCA(430,",DIC(0)="AQMEZ"
  1.  S DIC("S")="I $P(^(0),U,8)=16,$P($G(^PRCA(430.2,+$P(^(0),U,2),0)),U,6)=""T"""
  1.  S CNT=0 F  D  Q:($G(PRCABN)<0)!($G(RCOUT))
  1.  .D ^DIC S PRCABN=Y
  1.  .I $G(PRCABN)<0 Q
  1.  .I $G(PRCABN)="^" S RCOUT=1 Q
  1.  .I +$G(RCDIV(0)),'$$DIV^RCRCDIV(PRCABN) W !,"     <<Bill is not in selected division.>>",!
  1.  .S CNT=CNT+1,RCSBN=CNT
  1.  .S RCSBN(+PRCABN)=CNT
  1.  .S DIC("A")="Select another Active TP Accounts Receivable Bill No.: "
  1.  .QUIT
  1.  I '$O(RCSBN(0)) S RCOUT=1
  1.  K PRCABN,DIC,DA,X,Y,%Y
  1. BILLQ Q
  1.  ;
  1. PT ;  - Issue prompt for Patients
  1.  N DIC,X,Y
  1.  I $O(RCSPT(0)) S DIC("A")="Select another PATIENT: "
  1.  S DIC="^DPT(",DIC(0)="QMEAZ"
  1.  W ! D ^DIC K DIC I $E(Y)="^" S RCOUT=1 G PTQ
  1.  I Y<0,'$O(RCSPT(0)) S RCOUT=1
  1.  I Y<0 G PTQ
  1.  S RCSPT(+Y)=Y G PT
  1. PTQ Q
  1.  ;
  1. INS ; - determine range of carriers
  1.  R !!,"Build List for (S)elected Third Party Debtor(s) or a (R)ange: Range// ",X:DTIME
  1.  I ('$T)!(X["^") S RCOUT=1 G INSQ
  1.  S:X="" X="R" S X=$E(X)
  1.  I "SRsr"'[X W !!,?15,"Enter 'S' or 'R' or '^' to exit." G INS
  1.  W $S("sS"[X:"  Selected",1:"  Range") S RCSI=X
  1.  I "Rr"[RCSI G INS1
  1.  ;
  1.  S DIC("A")="Select THIRD PARTY AR DEBTOR: "
  1. INSA S DIC="^RCD(340,",DIC(0)="QEAZ",DIC("S")="I $P(^(0),U,1)[""DIC(36,"""
  1.  W ! D ^DIC K DIC I $E(Y)="^" S RCOUT=1 G INSQ
  1.  I Y<0,$O(RCSI(0)) G INSQ
  1.  I Y<0,'$O(RCSI(0)) G INS
  1.  S RCSI(+Y)=Y
  1.  S DIC("A")="Select another THIRD PARTY AR DEBTOR: "
  1.  G INSA
  1.  ;
  1. INS1 W !!!,"   START WITH DEBTOR: FIRST// " R X:DTIME
  1.  I ('$T)!(X["^") S RCOUT=1 G INSQ
  1.  I $E(X)="?" W !,?5,"Enter the name of the Insurance Company to start with." G INS1
  1.  S RCSIF=X
  1. INS2 W !,"   GO TO DEBTOR: LAST// " R X:DTIME
  1.  I ('$T)!(X["^") S RCOUT=1 G INSQ
  1.  I $E(X)="?" W !,?5,"Enter the name of the Insurance Company to end with." G INS2
  1.  I X="" S RCSIL="zzzzz" S:RCSIF="" RCSIA="ALL" G INSQ
  1.  I X="@",RCSIF="@" S RCSIL="@",RCSIA="NULL" G INSQ
  1.  I RCSIF'="@",RCSIF]X W *7,!!,"  The LAST value must follow the FIRST.",! G INS1
  1.  S RCSIL=X
  1. INSQ Q
  1.  ;
  1. ASK ;Ask optional questions
  1.  ;
  1.  ; - Build list for Selected Categories
  1.  S RCCAT="" D RCCAT^RCRCUTL(.RCCAT)
  1.  S (CNT,X)=0 K DIR
  1.  F  S X=$O(RCCAT(X)) Q:'X  D
  1.  .S CNT=CNT+1 S DIR("A",CNT)=CNT_"  "_$P(RCCAT(X),U,2)
  1.  S TCNT=CNT,CNT=CNT+1,DIR("A",CNT)=" "
  1.  S CNT=CNT+1,DIR("A",CNT)="  *Only Reimburs.Health Bills can be electronically referred at this time."
  1.  S CNT=CNT+1,DIR("A",CNT)=" "
  1.  S DIR("A")=" Enter response"
  1.  W !!,"AR Categories to Include in Build List"
  1.  W !," Select from the following:",!
  1.  S DIR(0)="L^1:"_TCNT
  1.  D ^DIR I $E(Y)="^" S RCOUT=1 G ASKQ
  1.  K RCCAT F I=1:1:TCNT I $P(Y,",",I) S RCCAT($P(DIR("A",$P(Y,",",I)),"  ",2))=""
  1.  I $D(DIRUT)!$D(DTOUT)!$D(DUOUT)!$D(DIROUT) G ASKQ
  1.  K DIR,DIROUT,DTOUT,DUOUT,DIRUT
  1.  ;
  1. AGE ; - determine the active receivable min age
  1.  S DIR(0)="NOA^1:99999",DIR("?")="Enter a number between (1-99999) or press return"
  1.  S DIR("A")="  (Optional) Enter the minimum age of the receivables: "
  1.  W !! D ^DIR S RCSAGN=+Y I $D(DTOUT)!$D(DUOUT)!$D(DIROUT) S RCOUT=1 G ASKQ
  1.  W:+RCSAGN !,"  -Bill age over ",RCSAGN," days."
  1.  K DIR,DIROUT,DTOUT,DUOUT,DIRUT
  1.  ;
  1.  ; - determine the active receivable max age
  1.  S DIR(0)="NOA^1:99999",DIR("?")="Enter a number between (1-99999) or press return"
  1.  S DIR("A")="  (Optional) Enter the maximum age of the receivables: "
  1.  W !! D ^DIR S RCSAGX=+Y I $D(DTOUT)!$D(DUOUT)!$D(DIROUT) S RCOUT=1 G ASKQ
  1.  W:+RCSAGX !,"  -Bill age under ",RCSAGX," days."
  1.  K DIR,DIROUT,DTOUT,DUOUT,DIRUT
  1.  ;
  1.  I $G(RCSAGX),+$G(RCSAGN)>+$G(RCSAGX) W !!,"Minimum age should be less than the Max. age.",!! G AGE
  1.  ;
  1.  ; - determine the active receivable minimum Amount
  1.  S DIR(0)="NOA^1:99999:2",DIR("?")="Enter a number between (1-99999) or press return"
  1.  S DIR("A")="  (Optional) Enter the minimum amount of the receivables: "
  1.  W !! D ^DIR S RCSAMT=+Y I $D(DTOUT)!$D(DUOUT)!$D(DIROUT) S RCOUT=1 G ASKQ
  1.  W:RCSAMT !,"  -Current Balance Over $",RCSAMT
  1.  K DIR,DIROUT,DTOUT,DUOUT,DIRUT
  1.  ;
  1.  ; - exclude receivables currently referred to Regional Counsel?
  1.  S DIR(0)="Y",DIR("B")="Yes"
  1.  S DIR("?")="Include receivables with a Referral Date in List"
  1.  S DIR("A")="Include currently referred receivables"
  1.  W !! D ^DIR S RCSRC=+Y
  1.  I $D(DIRUT)!$D(DTOUT)!$D(DUOUT)!$D(DIROUT) S RCOUT=1 G ASKQ
  1.  K DIR,DIROUT,DTOUT,DUOUT,DIRUT
  1.  ;
  1. ASKQ Q
  1.  ;
  1.  ;RCRCVLB