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

IBJDF5.m

Go to the documentation of this file. 
  1. IBJDF5 ;ALB/RB - CHAMPVA/TRICARE FOLLOW-UP REPORT;15-APR-00
  1.  ;;2.0;INTEGRATED BILLING;**123,185,240,452,739**;21-MAR-94;Build 3
  1.  ;;Per VHA Directive 2004-038, this routine should not be modified.
  1.  ;
  1. EN ; - Option entry point.
  1.  ;
  1.  ; - Select AR categories to print.
  1.  S IBPRT="Choose which category of receivables to print:"
  1.  K IBCTG
  1.  S IBCTG(1)="TRICARE PATIENT"
  1.  S IBCTG(2)="SHARING AGREEMENTS"
  1.  S IBCTG(3)="TRICARE"
  1.  S IBCTG(4)="TRICARE THIRD PARTY"
  1.  S IBCTG(5)="CHAMPVA"
  1.  S IBCTG(6)="CHAMPVA THIRD PARTY"
  1.  S IBCTG(7)="ALL OF THE ABOVE"
  1.  S IBSEL=$$MLTP^IBJD(IBPRT,.IBCTG,1) I 'IBSEL G ENQ
  1.  ;
  1.  S IBSD=0 I IBSEL="1," G TYP
  1.  ;
  1.  ; - Sort by division, if necessary.
  1.  S IBSD=$$SDIV^IBJD() G:IBSD["^" ENQ G:'IBSD TYP
  1.  ;
  1.  ; - Issue prompt for division.
  1.  I IBSD,IBSEL[1 D
  1.  . W !!,"NOTE: TRICARE Patient receivables will NOT be sorted"
  1.  . W !?6,"by division!",!,*7
  1.  ;
  1. TYP ; - Select type of receivables to print.
  1.  ; - Select AR categories to print.
  1.  S IBPRT="Choose which type of receivables to print:"
  1.  K IBTPR
  1.  S IBTPR(1)="INPATIENT"
  1.  S IBTPR(2)="OUTPATIENT"
  1.  S IBTPR(3)="PHARMACY REFILL"
  1.  S IBTPR(4)="ALL RECEIVABLES"
  1.  S IBSEL1=$$MLTP^IBJD(IBPRT,.IBTPR,1) I 'IBSEL1 G ENQ
  1.  ;
  1.  ; - Select a detailed or summary report.
  1.  D DS^IBJD G ENQ:IBRPT["^",DEV:IBRPT="S"
  1.  ;
  1.  ;Force sort by name
  1.  S IBSN="N" ;IB*2.0*739
  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 active AR's 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=1 D HELP^IBJDF5H G AGE
  1.  W "  ",$S("Rr"[X:"RANGE",1:"ALL")
  1.  S IBSMN=$S("Rr"[X:"R",1:"A") G:IBSMN="A" AMT
  1.  ;
  1.  ; - Determine the active receivable age range.
  1.  S DIR(0)="NA^1:99999"
  1.  S DIR("A")="Enter the minimum age of the active receivable: "
  1.  S DIR("T")=DTIME,DIR("?")="^S IBOFF=9 D HELP^IBJDF5H"
  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 active receivable: "
  1.  S DIR("B")=IBSMN,DIR("T")=DTIME,DIR("?")="^S IBOFF=14 D HELP^IBJDF5H"
  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=19 D HELP^IBJDF5H"
  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=26 D HELP^IBJDF5H"
  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() I Y S (IBEXCEL,IBSH)=1,IBSH1="M" G DEV
  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=31 D HELP^IBJDF5H"
  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 DEV
  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=40 D HELP^IBJDF5H"
  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" DEV
  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=47 D HELP^IBJDF5H"
  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. DEV ; - Select a device.
  1.  I '$G(IBEXCEL) D
  1.  . S X=$S(IBRPT="S":80,1:132)
  1.  . W !!,"You will need a ",X," column printer for this report!",!
  1.  . W !,"Note: This report will search through all  active  receivables."
  1.  . W !,"      You should  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^IBJDF5",ZTDESC="IB - CHAMPVA/TRICARE FOLLOW-UP REPORT"
  1.  .F I="IB*","VAUTD","VAUTD(" S ZTSAVE(I)=""
  1.  .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 6
  1.  ; reports: TRICARE Patient, Sharing Agreements, TRICARE, TRICARE 3rd 
  1.  ;          Party, CHAMPVA and CHAMPVA 3rd Party
  1. DQ I $G(IBXTRACT) F I=17:1:21 D E^IBJDE(I,1)
  1.  ;
  1.  D ST^IBJDF51 ;  Compile and print the report.
  1.  ;
  1. ENQ K IBSD,IBSEL,IBSEL1,IBSN,IBSNF,IBSNL,IBSNA,IBOFF,IBSH,IBSH1,IBSH2,IBSAM
  1.  K IBPRT,IBCTG,IBRPT,IBTPR,IBSMN,IBSMX,IBTEXT,IBI,IBEXCEL,DIROUT,DTOUT
  1.  K DTOUT,DIRUT,POP,VAUTD,%ZIS,ZTDESC,ZTRTN,ZTSAVE,I,X,Y
  1.  Q