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

IBJDF4.m

Go to the documentation of this file. 
  1. IBJDF4 ;ALB/RB - FIRST PARTY FOLLOW-UP REPORT ;15-APR-00
  1.  ;;2.0;INTEGRATED BILLING;**123,204,220,568,618,705,739**;21-MAR-94;Build 3
  1.  ;;Per VA Directive 6402, this routine should not be modified.
  1.  ;
  1.  ; Reference to 433.001 in ICR #7321
  1.  ; 
  1. EN ; - Option entry point.
  1.  S IBEXCEL=0
  1.  ; get suspension types from file 433.001 IB*2.0*705
  1.  N I,LAST,SUSCODE,SUSIEN,X
  1.  K IBSUS
  1.  S SUSCODE="" F  S SUSCODE=$O(^PRCA(433.001,"B",SUSCODE)) Q:SUSCODE=""  D
  1.  .S SUSIEN=$O(^PRCA(433.001,"B",SUSCODE,"")) Q:'SUSIEN
  1.  .S IBSUS(SUSCODE)=$$GET1^DIQ(433.001,SUSIEN_",",.02)
  1.  .Q
  1.  S LAST=$O(IBSUS(""),-1),IBSUS(LAST+1)="NONE"
  1.  S LAST=LAST+2,IBSUS(LAST)="ALL OF THE ABOVE"
  1.  ;
  1.  ; - Select AR categories to print.
  1.  S IBPRT="Choose which type of receivables to print:"
  1.  K IBOPT
  1.  S IBOPT(1)="EMERGENCY/HUMANITARIAN"
  1.  S IBOPT(2)="INELIGIBLE"
  1.  S IBOPT(3)="C-MEANS TEST & RX COPAY"
  1.  S IBOPT(4)="LONG TERM CARE COPAY"
  1.  S IBOPT(5)="COMMUNITY CARE COPAY"
  1.  S IBOPT(6)="ALL OF THE ABOVE"
  1.  S IBSEL=$$MLTP^IBJD(IBPRT,.IBOPT,1) I 'IBSEL G ENQ
  1.  ;
  1. STA ; - Choose bill status.
  1.  W !!,"Run report for (A)CTIVE ARs, (S)USPENDED ARs, or (B)OTH: B// "
  1.  R X:DTIME G:'$T!(X["^") ENQ S:X="" X="B" S X=$E(X)
  1.  I "AaBbSs"'[X S IBOFF=1 D HELP^IBJDF4H G STA
  1.  S IBSTA=$S("Aa"[X:"A","Ss"[X:"S",1:"B")
  1.  W "  ",$S(IBSTA="A":"ACTIVE",IBSTA="S":"SUSPENDED",1:"BOTH")
  1.  ;
  1. SUSTYP ;If SUSPENDED is chosen, prompt for which suspended bills to display IB*2.0*568/DRF
  1.  I IBSTA="S" D
  1.  . S IBPRT="Choose which suspended types to print:"
  1.  . S IBSELST=$$MLTP0(IBPRT,.IBSUS,1)
  1.  I IBSTA="S",IBSELST="" G ENQ
  1.  ;
  1.  ; - Select a detailed or summary report.
  1.  D DS G ENQ:IBRPT["^"
  1.  I IBRPT="S"!(IBRPT="O") D  G RC
  1.  . S IBSN="N",IBSNA="ALL",IBSNF="",IBSNL="zzzzz",IBSMN="A"
  1.  ;
  1.  ; - Determine sorting (By name or Last 4 SSN)
  1.  S IBSN="N" ;IB*2.0*739 force sorting by NAME
  1.  ;
  1.  ; - Determine the range
  1.  S X=$$INTV^IBJD("PATIENT "_$S(IBSN="N":"NAME",1:"LAST 4")) G ENQ:X="^"
  1.  S IBSNF=$P(X,"^",1),IBSNL=$P(X,"^",2),IBSNA=$P(X,"^",3)
  1.  ;
  1. AGE ; - Determine if the active receivable must be within an age range.
  1.  W !!,"Include (A)LL ",$S(IBSTA="A":"active ",IBSTA="S":"suspended ",1:""),"ARs or those within an AGE (R)ANGE: ALL// "
  1.  R X:DTIME G:'$T!(X["^") ENQ S:X="" X="A" S X=$E(X)
  1.  I "ARar"'[X S IBOFF=9 D HELP^IBJDF4H G AGE
  1.  S IBSMN=$S("Rr"[X:"R",1:"A") W "  ",$S(IBSMN="R":"RANGE",1:"ALL")
  1.  I IBSMN="A" G AMT
  1.  ;
  1.  ; - Determine the active receivable age range.
  1.  W !,"EXAMPLE Range: 31-60 days"
  1.  S DIR(0)="NA^1:99999"
  1.  S DIR("A")="Enter the minimum age of the receivable: "
  1.  S DIR("T")=DTIME,DIR("?")="^S IBOFF=16 D HELP^IBJDF4H"
  1.  D ^DIR K DIR G:$D(DIRUT)!$D(DTOUT)!$D(DUOUT)!$D(DIROUT) ENQ
  1.  S IBSMN=+Y W "   ",IBSMN," DAYS" K DIROUT,DTOUT,DUOUT,DIRUT
  1.  ;
  1.  S DIR(0)="NA^"_IBSMN_":99999"
  1.  S DIR("A")="Enter the maximum age of the receivable: "
  1.  S DIR("B")=IBSMN,DIR("T")=DTIME,DIR("?")="^S IBOFF=21 D HELP^IBJDF4H"
  1.  D ^DIR K DIR G:$D(DIRUT)!$D(DTOUT)!$D(DUOUT)!$D(DIROUT) 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("T")=DTIME,DIR("?")="^S IBOFF=26 D HELP^IBJDF4H"
  1.  D ^DIR K DIR G:$D(DIRUT)!$D(DTOUT)!$D(DUOUT)!$D(DIROUT) ENQ
  1.  S IBSAM=+Y K DIROUT,DTOUT,DUOUT,DIRUT G:'IBSAM EXCEL
  1.  ;
  1. AMT1 ; - Determine the minimum balance amount.
  1.  S DIR(0)="NA^1:9999999"
  1.  S DIR("A")="Enter the minimum balance amount of the receivable: "
  1.  S DIR("T")=DTIME,DIR("?")="^S IBOFF=33 D HELP^IBJDF4H"
  1.  D ^DIR K DIR G:$D(DIRUT)!$D(DTOUT)!$D(DUOUT)!$D(DIROUT) ENQ
  1.  S IBSAM=+Y K DIROUT,DTOUT,DUOUT,DIRUT
  1.  ;
  1. EXCEL ; - Determine whether to gather data for Excel report.
  1.  S IBEXCEL=$$EXCEL^IBJD() G ENQ:IBEXCEL="^"
  1.  I IBEXCEL S IBSH=1,IBSH1="M" G RC
  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("T")=DTIME,DIR("?")="^S IBOFF=38 D HELP^IBJDF4H"
  1.  D ^DIR K DIR G:$D(DIRUT)!$D(DTOUT)!$D(DUOUT)!$D(DIROUT) ENQ
  1.  S IBSH=+Y K DIROUT,DTOUT,DUOUT,DIRUT G:'IBSH RC
  1.  ;
  1.  S DIR(0)="SA^A:ALL;M:MOST RECENT"
  1.  S DIR("A")="Print (A)LL comments or the (M)OST RECENT comment: "
  1.  S DIR("B")="ALL",DIR("T")=DTIME,DIR("?")="^S IBOFF=47 D HELP^IBJDF4H"
  1.  D ^DIR K DIR G:$D(DIRUT)!$D(DTOUT)!$D(DUOUT)!$D(DIROUT) ENQ
  1.  S IBSH1=Y K DIROUT,DTOUT,DUOUT,DIRUT G:IBSH1="A" RC
  1.  ;
  1.  S DIR(0)="NAO^1:999"
  1.  S DIR("A")="Minimum age of most recent bill comment (optional): "
  1.  S DIR("T")=DTIME,DIR("?")="^S IBOFF=54 D HELP^IBJDF4H"
  1.  D ^DIR K DIR G:$D(DTOUT)!$D(DUOUT)!$D(DIROUT) ENQ
  1.  S IBSH2=+Y W:IBSH2 " days" K DIROUT,DTOUT,DUOUT
  1.  ;
  1. RC ; - Include receivables referred to Regional Counsel?
  1.  S DIR(0)="Y",DIR("B")="NO",DIR("T")=DTIME W !
  1.  S DIR("A")="Include ARs referred to Regional Counsel"
  1.  S DIR("?")="^S IBOFF=61 D HELP^IBJDF4H"
  1.  D ^DIR K DIR G:$D(DIRUT)!$D(DTOUT)!$D(DUOUT)!$D(DIROUT) ENQ
  1.  S IBSRC=+Y K DIROUT,DTOUT,DUOUT,DIRUT
  1.  ;
  1. DEV ; - Select a device.
  1.  I '$G(IBEXCEL) D
  1.  . W !!,"Note: This report will search through all "
  1.  . W $S(IBSTA="A":"active",IBSTA="S":"suspended",1:"active & suspended")," receivables."
  1.  . W !?6,"It is recommended that you queue it to run after normal business hours."
  1.  ;
  1.  I $G(IBEXCEL) D EXMSG^IBJD
  1.  ;
  1.  W ! S %ZIS="QM" D ^%ZIS G:POP ENQ
  1.  I $D(IO("Q")) D  G ENQ
  1.  .S ZTRTN="DQ^IBJDF4",ZTDESC="IB - FIRST PARTY FOLLOW-UP REPORT"
  1.  .S ZTSAVE("IB*")="" D ^%ZTLOAD
  1.  .I $G(ZTSK) W !!,"This job has been queued. The task no. is ",ZTSK,"."
  1.  .E  W !!,"Unable to queue this job."
  1.  .K ZTSK,IO("Q") D HOME^%ZIS
  1.  ;
  1.  U IO
  1.  ;
  1.  ; If called by the Extraction Module, change extract status for the  5
  1.  ; reports: Emergency/Humanitarian, Ineligible receivables, C-Means Test,
  1.  ;          RX Copay/SC VET and RX Copay/NSC VET
  1. DQ I $G(IBXTRACT) F I=12:1:16 D E^IBJDE(I,1)
  1.  ;
  1.  D ST^IBJDF41 ;   Compile and print the report.
  1.  ;
  1. ENQ K IBSEL,IBSN,IBSNF,IBSNL,IBOFF,IBSNA,IBSH,IBSH1,IBSH2,IBSAM,IBSRC,IBTEXT
  1.  K IBI,IBOPT,IBPRT,IBSTA,IBEXCEL,IBRPT,IBSMN,IBSMX,IBSELST,IBSUSTYP,POP,DIROUT,DTOUT,DUOUT
  1.  K DIRUT,%ZIS,ZTDESC,ZTRTN,ZTSAVE,I,X,Y
  1.  Q
  1.  ;
  1. MLTP0(PRPT,OPT,ALL) ; Function for multiple value selection
  1.  ; Input: PRPT - String to be prompted to the user, before listing options
  1.  ;        OPT  - Array containing the possible entries (indexed by code)
  1.  ;               Obs: Code must be sequential starting with 0
  1.  ;        ALL  - Flag indicating if the last option is ALL OF THE ABOVE
  1.  ;
  1.  ; Output: MLTP - User selection, i.e. ",1,2,3," or "1," or NULL (nothing
  1.  ;                 was selected)
  1.  ;
  1.  N A,DIR,DIRUT,DTOUT,DUOUT,DIROUT,I,IX,LST,MLTP
  1.  ;
  1. PRPT S MLTP="",ALL=+$G(ALL)
  1.  S LST=$O(OPT(""),-1)
  1.  S DIR(0)="LO^0:"_LST_"^K:+$P(X,""-"",2)>"_LST_" X"
  1.  S DIR("A",1)=$G(PRPT),DIR("A",2)=""
  1.  S A="",IX=3
  1.  F  S A=$O(OPT(A))  Q:A=""  D
  1.  . S DIR("A",IX)="   "_A_" - "_$G(OPT(A)),IX=IX+1
  1.  S DIR("A",IX)="",DIR("A")="Select",DIR("B")=LST,DIR("T")=DTIME W !
  1.  D ^DIR K DIR I $D(DIRUT)!$D(DTOUT)!$D(DUOUT)!$D(DIROUT) G QT
  1.  S MLTP=Y K DIROUT,DTOUT,DUOUT,DIRUT
  1.  ;
  1.  I ALL,MLTP[LST S MLTP=LST_","
  1.  ;
  1.  S DIR(0)="Y",DIR("A",1)="You have selected",DIR("A",2)=""
  1.  S A="",IX=3
  1.  F I=1:1:($L(MLTP,",")-1) D
  1.  . S DIR("A",IX)="    "_$P(MLTP,",",I)_" - "_$G(OPT($P(MLTP,",",I)))
  1.  . S IX=IX+1
  1.  S DIR("A",IX)=""
  1.  S DIR("A")="Are you sure",DIR("B")="NO",DIR("T")=DTIME W !
  1.  D ^DIR K DIR I $D(DIRUT)!$D(DTOUT)!$D(DUOUT)!$D(DIROUT) S MLTP="" G QT
  1.  K DIROUT,DTOUT,DUOUT,DIRUT I 'Y K DIR G PRPT
  1.  ;
  1.  I ALL,MLTP[LST D
  1.  . S MLTP="" F I=(LST-1):-1:0 S MLTP=I_","_MLTP
  1.  ;
  1. QT I MLTP'="" S MLTP=","_MLTP
  1.  Q MLTP
  1.  ;
  1. DS ; Print a (S)ummary,(O)verall Summary or (D)etail Report?
  1.  S DIR(0)="SA^S:SUMMARY;D:DETAILED;O:OVERALL SUMMARY;"
  1.  S DIR("A")="Do you wish to print a (S)ummary, (O)verall Summary or (D)etailed Report? "
  1.  S DIR("?")="^D HDS^IBJDF4"  ; IB*2.0*705
  1.  W ! D ^DIR K DIR S IBRPT=Y
  1.  Q
  1.  ;
  1. HDS ; Help for Summary/Detail prompt.  ; IB*2.0*705
  1.  W !,"Please enter 'S' for 'Summary', 'O' for 'Overall Summary' or 'D' for a Detailed Report."
  1.  W !,"Note that if you select the Detailed report, Summary and Overall Summary will also print."
  1.  Q