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

IBJDF1.m

Go to the documentation of this file.
  1. IBJDF1 ;ALB/CPM - THIRD PARTY FOLLOW-UP REPORT ;09-JAN-97
  1. ;;2.0;INTEGRATED BILLING;**69,118,128,205,554,618,663,739**;21-MAR-94;Build 3
  1. ;Per VA Directive 6402, this routine should not be modified.
  1. ;
  1. EN ; - Option entry point.
  1. ;
  1. W !!,"This report provides a tool for sites to use to perform follow-up"
  1. W !,"activities for Third Party receivables.",!
  1. ;
  1. DATE ; - Choose date to use for calculation
  1. W !!,"Calculate report using (D)ATE OF CARE or (A)CTIVE IN AR (days): (A)CTIVE IN AR// " R X:DTIME
  1. G:'$T!(X["^") ENQ S:X="" X="A" S X=$E(X)
  1. I "ADad"'[X S IBOFF=99 D HELP^IBJDF1H G DATE
  1. W " ",$S("Dd"[X:"DATE OF CARE",1:"(DAYS) ACTIVE IN AR")
  1. S IBSDATE=$S("Dd"[X:"D",1:"A")
  1. ;
  1. ; - Sort by division.
  1. S DIR(0)="Y",DIR("B")="NO"
  1. S DIR("A")="Do you wish to sort this report by division"
  1. S DIR("?")="^S IBOFF=1 D HELP^IBJDF1H"
  1. D ^DIR K DIR I $D(DIRUT)!$D(DTOUT)!$D(DUOUT)!$D(DIROUT) G ENQ
  1. S IBSD=+Y K DIROUT,DTOUT,DUOUT,DIRUT
  1. ;
  1. ; - Issue prompt for division.
  1. I IBSD D PSDR^IBODIV G:Y<0 ENQ
  1. ;
  1. INS ; - Determine range of carriers.
  1. W !!,"Run report for (S)PECIFIC insurance companies or a (R)ANGE: RANGE// "
  1. R X:DTIME G:'$T!(X["^") ENQ S:X="" X="R" S X=$E(X)
  1. I "RSrs"'[X S IBOFF=8 D HELP^IBJDF1H G INS
  1. W " ",$S("Ss"[X:"SPECIFIC",1:"RANGE") G:"Rr"[X INS1 K IBSI
  1. INS0 S DIC="^DIC(36,",DIC(0)="AEQMZ",DIC("S")="I '$G(^(5))"
  1. S DIC("A")=" Select "_$S($G(IBSI):"another ",1:"")_"INSURANCE CO.: "
  1. D ^DIC K DIC I Y'>0 G ENQ:'$G(IBSI),NAM
  1. I $D(IBSI(+Y)) D G INS0
  1. .W !!?3,"Already selected. Choose another insurance company.",!,*7
  1. S IBSI(+Y)="" S:'$G(IBSI) IBSI=1 G INS0
  1. INS1 R !?3,"START WITH INSURANCE COMPANY: FIRST// ",X:DTIME G:'$T!(X["^") ENQ
  1. I $E(X)="?" S IBOFF=14 D HELP^IBJDF1H G INS1
  1. S IBSIF=X
  1. INS2 R !?8,"GO TO INSURANCE COMPANY: LAST// ",X:DTIME G:'$T!(X["^") ENQ
  1. I $E(X)="?" S IBOFF=21 D HELP^IBJDF1H G INS2
  1. I X="" S IBSIL="zzzzz" S:IBSIF="" IBSIA="ALL" G NAM
  1. I X="@",IBSIF="@" S IBSIL="@",IBSIA="NULL" G NAM
  1. I IBSIF'="@",IBSIF]X D G INS2
  1. .W *7,!!?4,"The LAST value must follow the FIRST.",!
  1. S IBSIL=X
  1. ;
  1. NAM ; - Determine range of patients.
  1. ;S DIR(0)="SA^N:NAME;L:LAST 4" ;IB*2.0*739
  1. ;S DIR("A")="Sort Patients by (N)AME or (L)AST of the SSN: " ;IB*2.0*739
  1. ;S DIR("B")="NAME",DIR("T")=20,DIR("?")="^S IBOFF=29 D HELP^IBJDF1H" ;IB*2.0*739
  1. ;W ! D ^DIR K DIR G:Y=""!(X="^") ENQ S IBSN=Y,IBI=Y(0) ;IB*2.0*739
  1. S IBSN="N",IBI="NAME" ;IB*2.0*739
  1. NAM1 W !?3,"START WITH PATIENT ",IBI,": FIRST// " R X:DTIME G:'$T!(X["^") ENQ
  1. I $E(X)="?" S IBOFF=36 D HELP^IBJDF1H G NAM1
  1. S IBSNF=X
  1. NAM2 W !?8,"GO TO PATIENT ",IBI,": LAST// " R X:DTIME G:'$T!(X["^") ENQ
  1. I $E(X)="?" S IBOFF=43 D HELP^IBJDF1H G NAM2
  1. I X="" S IBSNL="zzzzz" S:IBSNF="" IBSNA="ALL" G TYP
  1. I X="@",IBSNF="@" S IBSNL="@",IBSNA="NULL" G TYP
  1. I IBSNF'="@",IBSNF]X D G NAM2
  1. .W *7,!!?7,"The LAST value must follow the FIRST.",!
  1. S IBSNL=X
  1. ;
  1. TYP ; - Select type of receivables to print.
  1. ; IB*2.0*554/DRF 10/20/2015 Add Non-VA care
  1. ; IB*2.0*? Changed Non-VA care to Community Care
  1. W !!,"Choose which type of receivables to print:",!
  1. S DIR(0)="LO^1:5^K:+$P(X,""-"",2)>5 X"
  1. S DIR("A",1)=" 1 - INPATIENT"
  1. S DIR("A",2)=" 2 - OUTPATIENT"
  1. S DIR("A",3)=" 3 - PHARMACY REFILL"
  1. S DIR("A",4)=" 4 - COMMUNITY CARE RECEIVABLES"
  1. S DIR("A",5)=" 5 - ALL RECEIVABLES"
  1. S DIR("A",6)="",DIR("A")="Select",DIR("B")=5
  1. D ^DIR K DIR I $D(DIRUT)!$D(DTOUT)!$D(DUOUT)!$D(DIROUT) G ENQ
  1. S IBSEL=Y K DIROUT,DTOUT,DUOUT,DIRUT
  1. ;
  1. AR ; - Determine if the active receivable must be within an age range.
  1. W !!,"Include (A)LL active AR's or those within an AGE (R)ANGE: ALL// " R X:DTIME
  1. G:'$T!(X["^") ENQ S:X="" X="A" S X=$E(X)
  1. I "ARar"'[X S IBOFF=51 D HELP^IBJDF1H G AR
  1. W " ",$S("Rr"[X:"RANGE",1:"ALL")
  1. S IBSMN=$S("Rr"[X:"R",1:"A") I IBSMN="A" G AMT
  1. ;
  1. AGE ;-Determine the active receivable age range.
  1. S DIR(0)="NA^1:99999",DIR("?")="^S IBOFF=59 D HELP^IBJDF1H"
  1. S DIR("A")=" Enter the minimum age of the active receivable: "
  1. D ^DIR K DIR I $D(DIRUT)!$D(DTOUT)!$D(DUOUT)!$D(DIROUT) G ENQ
  1. S IBSMN=+Y W " ",IBSMN," DAYS" K DIROUT,DTOUT,DUOUT,DIRUT
  1. ;
  1. S DIR(0)="NA^"_IBSMN_":99999",DIR("?")="^S IBOFF=64 D HELP^IBJDF1H"
  1. S DIR("A")=" Enter the maximum age of the active receivable: "
  1. S DIR("B")=IBSMN D ^DIR K DIR
  1. I $D(DIRUT)!$D(DTOUT)!$D(DUOUT)!$D(DIROUT) G ENQ
  1. S IBSMX=+Y W " ",IBSMX," DAYS" K DIROUT,DTOUT,DUOUT,DIRUT
  1. ;
  1. AMT ; - Print receivables with a minimum balance.
  1. S DIR(0)="Y",DIR("B")="NO" W !
  1. S DIR("A")="Print receivables with a minimum balance"
  1. S DIR("?")="^S IBOFF=69 D HELP^IBJDF1H"
  1. D ^DIR K DIR I $D(DIRUT)!$D(DTOUT)!$D(DUOUT)!$D(DIROUT) G ENQ
  1. S IBSAM=+Y K DIROUT,DTOUT,DUOUT,DIRUT I 'IBSAM G BCH
  1. ;
  1. AMT1 ; - Determine the minimum balance amount.
  1. S DIR(0)="NA^1:9999999",DIR("?")="^S IBOFF=76 D HELP^IBJDF1H"
  1. S DIR("A")=" Enter the minimum balance amount of the receivable: "
  1. D ^DIR K DIR I $D(DIRUT)!$D(DTOUT)!$D(DUOUT)!$D(DIROUT) G ENQ
  1. S IBSAM=+Y K DIROUT,DTOUT,DUOUT,DIRUT
  1. ;
  1. BCH ; - Determine whether to include the bill comment history.
  1. S DIR(0)="Y",DIR("B")="NO" W !
  1. S DIR("A")="Include the Bill Comment history with each receivable"
  1. S DIR("?")="^S IBOFF=81 D HELP^IBJDF1H"
  1. D ^DIR K DIR I $D(DIRUT)!$D(DTOUT)!$D(DUOUT)!$D(DIROUT) G ENQ
  1. S IBSH=+Y K DIROUT,DTOUT,DUOUT,DIRUT
  1. ;
  1. RC ; - Include receivables referred to Regional Counsel?
  1. S DIR(0)="Y",DIR("B")="NO" W !
  1. S DIR("A")="Include receivables referred to Regional Counsel"
  1. S DIR("?")="^S IBOFF=90 D HELP^IBJDF1H"
  1. D ^DIR I $D(DIRUT)!$D(DTOUT)!$D(DUOUT)!$D(DIROUT) G ENQ
  1. S IBSRC=+Y K DIROUT,DTOUT,DUOUT,DIRUT
  1. ;
  1. W !!,"This report requires a 132 column printer."
  1. W !!,"Note: This report will search through all active receivables."
  1. W !?6,"You should queue this report to run after normal business hours."
  1. ;
  1. ; - Select a device.
  1. W ! S %ZIS="QM" D ^%ZIS G:POP ENQ
  1. I $D(IO("Q")) D G ENQ
  1. .S ZTRTN="DQ^IBJDF11",ZTDESC="IB - THIRD PARTY FOLLOW-UP REPORT"
  1. .F I="IBS*","VAUTD","VAUTD(" S ZTSAVE(I)=""
  1. .D ^%ZTLOAD
  1. .W !!,$S($D(ZTSK):"This job has been queued. The task number is "_ZTSK_".",1:"Unable to queue this job.")
  1. .K ZTSK,IO("Q") D HOME^%ZIS
  1. ;
  1. U IO
  1. ;
  1. D DQ^IBJDF11 ; Compile and print the report.
  1. ;
  1. ENQ K IBSD,IBSEL,IBSI,IBSIF,IBSIL,IBSIA,IBSN,IBSNF,IBSNL,IBOFF,IBSNA,IBSH
  1. K IBSAM,IBSDATE,IBSMN,IBSMX,IBSRC,IBTEXT,IBI,POP,VAUTD,%ZIS,ZTDESC,ZTRTN,ZTSAVE,DIR
  1. K DIROUT,DTOUT,DUOUT,DIRUT
  1. Q