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

IBJDF6.m

Go to the documentation of this file.
  1. IBJDF6 ;ALB/RB - MISCELLANEOUS BILLS FOLLOW-UP REPORT ;15-APR-00
  1. ;;2.0;INTEGRATED BILLING;**123,159,618**;21-MAR-94;Build 61
  1. ;
  1. EN ; - Option entry point.
  1. ;
  1. SEL ; - Select type of receivables to print.
  1. K IBCTG S IBPRT="Choose which type of receivables to print:"
  1. S IBCTG(1)="MEDICARE"
  1. S IBCTG(2)="NO-FAULT AUTO ACCIDENT"
  1. S IBCTG(3)="COMMUNITY CARE NO-FAULT AUTO ACCIDENT"
  1. S IBCTG(4)="TORT FEASOR"
  1. S IBCTG(5)="COMMUNITY CARE TORT FEASOR"
  1. S IBCTG(6)="WORKMEN'S COMP"
  1. S IBCTG(7)="COMMUNITY CARE WORKMEN'S COMP"
  1. S IBCTG(8)="CURRENT EMPLOYEE"
  1. S IBCTG(9)="EX-EMPLOYEE"
  1. S IBCTG(10)="FEDERAL AGENCIES-REFUND"
  1. S IBCTG(11)="FEDERAL AGENCIES-REIMBURSEMENT"
  1. S IBCTG(12)="MILITARY"
  1. S IBCTG(13)="INTERAGENCY"
  1. S IBCTG(14)="VENDOR"
  1. S IBCTG(15)="ALL OF THE ABOVE"
  1. ;
  1. S IBSEL=$$MLTP^IBJD(IBPRT,.IBCTG,1) I 'IBSEL G ENQ
  1. S (IB0,IB1)=0
  1. F X=1:1 S Y=$P(IBSEL,",",X) Q:'Y D
  1. . I Y<8 S IB0=1 Q ;IB*2.0*618
  1. . S IB1=1
  1. G ENQ:'IBSEL S IBSEL=","_IBSEL
  1. ;
  1. ; - Sort by division.
  1. S IBSDV=0 I IB0 S IBSDV=$$SDIV^IBJD() I IBSDV["^" G ENQ
  1. ;
  1. ; - Select a detailed or summary report.
  1. D DS^IBJD I IBRPT["^" G ENQ
  1. ;
  1. ;IB*2.0*618 - changed starting point from selection 4 to selection 8
  1. ; Display receivables not sorting by division
  1. I IBSDV S IB2=0 F X=2:1 S Y=$P(IBSEL,",",X) Q:'Y D
  1. . ; Only display options 8-14
  1. . Q:Y<8
  1. . Q:Y>14
  1. . I 'IB2 D S IB2=1
  1. . . W !!,"NOTE: The receivables of these types will NOT be sorted by division:",!,*7
  1. . W !?6,IBCTG(Y)
  1. ;end IB*2.0*618
  1. ;
  1. G DEV:IBRPT="S"
  1. ;
  1. ; - Determine sorting (By name or Last 4 SSN)
  1. S (IBSN,X)=""
  1. I IB0 D I IBSN="^"!(X="^") G ENQ
  1. . S IBSN=$$SNL^IBJD() Q:IBSN="^"
  1. . W !!,"These receivables will be sorted by PATIENT/SSN:",!
  1. . F X=2:1 S Y=$P(IBSEL,",",X) Q:'Y I Y<8 W !?6,IBCTG(Y)
  1. . ; - Determine the PATIENT range
  1. . S X=$$INTV^IBJD("PATIENT "_$S(IBSN="N":"NAME",1:"LAST 4")) Q:X="^"
  1. . S IBSNF=$P(X,"^",1),IBSNL=$P(X,"^",2),IBSNA=$P(X,"^",3)
  1. ;
  1. ; - Determine range of debtors.
  1. I 'IB1 G AGE
  1. ;
  1. I IB1 D
  1. . W !!,"These receivables will be sorted by DEBTOR:",!
  1. . F X=2:1 S Y=$P(IBSEL,",",X) Q:'Y I Y>4 W !?6,IBCTG(Y)
  1. S VAUTD(0)=""
  1. ;
  1. ; - Determine the DEBTOR range
  1. S X=$$INTV^IBJD("DEBTOR") G ENQ:X="^"
  1. S IBSDF=$P(X,"^",1),IBSDL=$P(X,"^",2),IBSDA=$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^IBJDF6H 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^IBJDF6H"
  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",DIR("B")=IBSMN
  1. S DIR("A")="Enter the maximum age of the active receivable: "
  1. S DIR("T")=DTIME,DIR("?")="^S IBOFF=14 D HELP^IBJDF6H"
  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^IBJDF6H"
  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^IBJDF6H"
  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 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^IBJDF6H"
  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^IBJDF6H"
  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^IBJDF6H"
  1. D ^DIR K DIR G:$D(DTOUT)!$D(DUOUT)!$D(DIROUT) ENQ
  1. S IBSH2=+Y W:IBSH2 " DAYS" K DIROUT,DTOUT,DUOUT,DIRUT
  1. ;
  1. DEV ; - Select a device.
  1. K IB0,IB1,IB2
  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^IBJDF6",ZTDESC="IB - MISC. BILLS FOLLOW-UP REPORT"
  1. . F I="IB*","VAUTD","VAUTD(" S ZTSAVE(I)=""
  1. . D ^%ZTLOAD
  1. . I $D(ZTSK) W !!,"This job has been queued. Task number 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 3
  1. ; reports: No-fault auto accident, Tort Feasor and Workman's Comp
  1. DQ I $G(IBXTRACT) F I=22:1:24 D E^IBJDE(I,1)
  1. ;
  1. D ST^IBJDF61 ; Compile and print the report.
  1. ;
  1. ENQ K IBSDA,IBSDF,IBSDL,IBSDV,IBSEL,IBSN,IBSNA,IBSNF,IBSNL,IBSH,IBSH1,IBSH2
  1. K IBCTG,IBCTS,IBOFF,IBPRT,IBRPT,IBSAM,IBSMN,IBSMX,IBTEXT,IBI,DIROUT
  1. K DTOUT,DUOUT,DIRUT,POP,VAUTD,%ZIS,ZTDESC,ZTRTN,ZTSAVE,I,X,Y,Z
  1. Q