- IBJDF6 ;ALB/RB - MISCELLANEOUS BILLS FOLLOW-UP REPORT ;15-APR-00
- ;;2.0;INTEGRATED BILLING;**123,159,618**;21-MAR-94;Build 61
- ;
- EN ; - Option entry point.
- ;
- SEL ; - Select type of receivables to print.
- K IBCTG S IBPRT="Choose which type of receivables to print:"
- S IBCTG(1)="MEDICARE"
- S IBCTG(2)="NO-FAULT AUTO ACCIDENT"
- S IBCTG(3)="COMMUNITY CARE NO-FAULT AUTO ACCIDENT"
- S IBCTG(4)="TORT FEASOR"
- S IBCTG(5)="COMMUNITY CARE TORT FEASOR"
- S IBCTG(6)="WORKMEN'S COMP"
- S IBCTG(7)="COMMUNITY CARE WORKMEN'S COMP"
- S IBCTG(8)="CURRENT EMPLOYEE"
- S IBCTG(9)="EX-EMPLOYEE"
- S IBCTG(10)="FEDERAL AGENCIES-REFUND"
- S IBCTG(11)="FEDERAL AGENCIES-REIMBURSEMENT"
- S IBCTG(12)="MILITARY"
- S IBCTG(13)="INTERAGENCY"
- S IBCTG(14)="VENDOR"
- S IBCTG(15)="ALL OF THE ABOVE"
- ;
- S IBSEL=$$MLTP^IBJD(IBPRT,.IBCTG,1) I 'IBSEL G ENQ
- S (IB0,IB1)=0
- F X=1:1 S Y=$P(IBSEL,",",X) Q:'Y D
- . I Y<8 S IB0=1 Q ;IB*2.0*618
- . S IB1=1
- G ENQ:'IBSEL S IBSEL=","_IBSEL
- ;
- ; - Sort by division.
- S IBSDV=0 I IB0 S IBSDV=$$SDIV^IBJD() I IBSDV["^" G ENQ
- ;
- ; - Select a detailed or summary report.
- D DS^IBJD I IBRPT["^" G ENQ
- ;
- ;IB*2.0*618 - changed starting point from selection 4 to selection 8
- ; Display receivables not sorting by division
- I IBSDV S IB2=0 F X=2:1 S Y=$P(IBSEL,",",X) Q:'Y D
- . ; Only display options 8-14
- . Q:Y<8
- . Q:Y>14
- . I 'IB2 D S IB2=1
- . . W !!,"NOTE: The receivables of these types will NOT be sorted by division:",!,*7
- . W !?6,IBCTG(Y)
- ;end IB*2.0*618
- ;
- G DEV:IBRPT="S"
- ;
- ; - Determine sorting (By name or Last 4 SSN)
- S (IBSN,X)=""
- I IB0 D I IBSN="^"!(X="^") G ENQ
- . S IBSN=$$SNL^IBJD() Q:IBSN="^"
- . W !!,"These receivables will be sorted by PATIENT/SSN:",!
- . F X=2:1 S Y=$P(IBSEL,",",X) Q:'Y I Y<8 W !?6,IBCTG(Y)
- . ; - Determine the PATIENT range
- . S X=$$INTV^IBJD("PATIENT "_$S(IBSN="N":"NAME",1:"LAST 4")) Q:X="^"
- . S IBSNF=$P(X,"^",1),IBSNL=$P(X,"^",2),IBSNA=$P(X,"^",3)
- ;
- ; - Determine range of debtors.
- I 'IB1 G AGE
- ;
- I IB1 D
- . W !!,"These receivables will be sorted by DEBTOR:",!
- . F X=2:1 S Y=$P(IBSEL,",",X) Q:'Y I Y>4 W !?6,IBCTG(Y)
- S VAUTD(0)=""
- ;
- ; - Determine the DEBTOR range
- S X=$$INTV^IBJD("DEBTOR") G ENQ:X="^"
- S IBSDF=$P(X,"^",1),IBSDL=$P(X,"^",2),IBSDA=$P(X,"^",3)
- ;
- AGE ; - Determine if the active receivable must be within an age range.
- W !!,"Include (A)LL active AR's or those within an AGE (R)ANGE: ALL// "
- R X:DTIME G:'$T!(X["^") ENQ S:X="" X="A" S X=$E(X)
- I "ARar"'[X S IBOFF=1 D HELP^IBJDF6H G AGE
- W " ",$S("Rr"[X:"RANGE",1:"ALL")
- S IBSMN=$S("Rr"[X:"R",1:"A") G:IBSMN="A" AMT
- ;
- ; - Determine the active receivable age range.
- S DIR(0)="NA^1:99999"
- S DIR("A")="Enter the minimum age of the active receivable: "
- S DIR("T")=DTIME,DIR("?")="^S IBOFF=9 D HELP^IBJDF6H"
- D ^DIR K DIR G:$D(DIRUT)!$D(DTOUT)!$D(DUOUT)!$D(DIROUT) ENQ
- S IBSMN=+Y W " ",IBSMN," DAYS" K DIROUT,DTOUT,DUOUT,DIRUT
- ;
- S DIR(0)="NA^"_IBSMN_":99999",DIR("B")=IBSMN
- S DIR("A")="Enter the maximum age of the active receivable: "
- S DIR("T")=DTIME,DIR("?")="^S IBOFF=14 D HELP^IBJDF6H"
- D ^DIR K DIR G:$D(DIRUT)!$D(DTOUT)!$D(DUOUT)!$D(DIROUT) ENQ
- S IBSMX=+Y W " ",IBSMX," DAYS" K DIROUT,DTOUT,DUOUT,DIRUT
- ;
- AMT ; - Print receivables with a minimum balance.
- S DIR(0)="Y",DIR("B")="NO" W !
- S DIR("A")="Print receivables with a minimum balance"
- S DIR("T")=DTIME,DIR("?")="^S IBOFF=19 D HELP^IBJDF6H"
- D ^DIR K DIR G:$D(DIRUT)!$D(DTOUT)!$D(DUOUT)!$D(DIROUT) ENQ
- S IBSAM=+Y K DIROUT,DTOUT,DUOUT,DIRUT G:'IBSAM EXCEL
- ;
- AMT1 ; - Determine the minimum balance amount.
- S DIR(0)="NA^1:9999999"
- S DIR("A")="Enter the minimum balance amount of the receivable: "
- S DIR("T")=DTIME,DIR("?")="^S IBOFF=26 D HELP^IBJDF6H"
- D ^DIR K DIR G:$D(DIRUT)!$D(DTOUT)!$D(DUOUT)!$D(DIROUT) ENQ
- S IBSAM=+Y K DIROUT,DTOUT,DUOUT,DIRUT
- ;
- EXCEL ; - Determine whether to gather data for Excel report.
- S IBEXCEL=$$EXCEL^IBJD() G ENQ:IBEXCEL="^"
- I IBEXCEL S IBSH=1,IBSH1="M" G DEV
- ;
- BCH ; - Determine whether to include the bill comment history.
- S DIR(0)="Y",DIR("B")="NO" W !
- S DIR("A")="Include the bill comment history with each receivable"
- S DIR("T")=DTIME,DIR("?")="^S IBOFF=31 D HELP^IBJDF6H"
- D ^DIR K DIR G:$D(DIRUT)!$D(DTOUT)!$D(DUOUT)!$D(DIROUT) ENQ
- S IBSH=+Y K DIROUT,DTOUT,DUOUT,DIRUT G:'IBSH DEV
- ;
- S DIR(0)="SA^A:ALL;M:MOST RECENT"
- S DIR("A")="Print (A)LL comments or the (M)OST RECENT comment: "
- S DIR("B")="ALL",DIR("T")=DTIME,DIR("?")="^S IBOFF=40 D HELP^IBJDF6H"
- D ^DIR K DIR G:$D(DIRUT)!$D(DTOUT)!$D(DUOUT)!$D(DIROUT) ENQ
- S IBSH1=Y K DIROUT,DTOUT,DUOUT,DIRUT G:IBSH1="A" DEV
- ;
- S DIR(0)="NAO^1:999"
- S DIR("A")="Minimum age of most recent bill comment (optional): "
- S DIR("T")=DTIME,DIR("?")="^S IBOFF=47 D HELP^IBJDF6H"
- D ^DIR K DIR G:$D(DTOUT)!$D(DUOUT)!$D(DIROUT) ENQ
- S IBSH2=+Y W:IBSH2 " DAYS" K DIROUT,DTOUT,DUOUT,DIRUT
- ;
- DEV ; - Select a device.
- K IB0,IB1,IB2
- I '$G(IBEXCEL) D
- . S X=$S(IBRPT="S":80,1:132)
- . W !!,"You will need a ",X," column printer for this report!",!
- . W !,"Note: This report will search through all active receivables."
- . W !," You should queue it to run after normal business hours.",!
- ;
- I $G(IBEXCEL) D EXMSG^IBJD
- ;
- W ! S %ZIS="QM" D ^%ZIS G:POP ENQ
- I $D(IO("Q")) D G ENQ
- . S ZTRTN="DQ^IBJDF6",ZTDESC="IB - MISC. BILLS FOLLOW-UP REPORT"
- . F I="IB*","VAUTD","VAUTD(" S ZTSAVE(I)=""
- . D ^%ZTLOAD
- . I $D(ZTSK) W !!,"This job has been queued. Task number is ",ZTSK,"."
- . E W !!,"Unable to queue this job."
- . K ZTSK,IO("Q") D HOME^%ZIS
- ;
- U IO
- ;
- ; If called by the Extraction Module, change extract status for the 3
- ; reports: No-fault auto accident, Tort Feasor and Workman's Comp
- DQ I $G(IBXTRACT) F I=22:1:24 D E^IBJDE(I,1)
- ;
- D ST^IBJDF61 ; Compile and print the report.
- ;
- ENQ K IBSDA,IBSDF,IBSDL,IBSDV,IBSEL,IBSN,IBSNA,IBSNF,IBSNL,IBSH,IBSH1,IBSH2
- K IBCTG,IBCTS,IBOFF,IBPRT,IBRPT,IBSAM,IBSMN,IBSMX,IBTEXT,IBI,DIROUT
- K DTOUT,DUOUT,DIRUT,POP,VAUTD,%ZIS,ZTDESC,ZTRTN,ZTSAVE,I,X,Y,Z
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBJDF6 6073 printed Feb 18, 2025@23:49:20 Page 2
- IBJDF6 ;ALB/RB - MISCELLANEOUS BILLS FOLLOW-UP REPORT ;15-APR-00
- +1 ;;2.0;INTEGRATED BILLING;**123,159,618**;21-MAR-94;Build 61
- +2 ;
- EN ; - Option entry point.
- +1 ;
- SEL ; - Select type of receivables to print.
- +1 KILL IBCTG
- SET IBPRT="Choose which type of receivables to print:"
- +2 SET IBCTG(1)="MEDICARE"
- +3 SET IBCTG(2)="NO-FAULT AUTO ACCIDENT"
- +4 SET IBCTG(3)="COMMUNITY CARE NO-FAULT AUTO ACCIDENT"
- +5 SET IBCTG(4)="TORT FEASOR"
- +6 SET IBCTG(5)="COMMUNITY CARE TORT FEASOR"
- +7 SET IBCTG(6)="WORKMEN'S COMP"
- +8 SET IBCTG(7)="COMMUNITY CARE WORKMEN'S COMP"
- +9 SET IBCTG(8)="CURRENT EMPLOYEE"
- +10 SET IBCTG(9)="EX-EMPLOYEE"
- +11 SET IBCTG(10)="FEDERAL AGENCIES-REFUND"
- +12 SET IBCTG(11)="FEDERAL AGENCIES-REIMBURSEMENT"
- +13 SET IBCTG(12)="MILITARY"
- +14 SET IBCTG(13)="INTERAGENCY"
- +15 SET IBCTG(14)="VENDOR"
- +16 SET IBCTG(15)="ALL OF THE ABOVE"
- +17 ;
- +18 SET IBSEL=$$MLTP^IBJD(IBPRT,.IBCTG,1)
- IF 'IBSEL
- GOTO ENQ
- +19 SET (IB0,IB1)=0
- +20 FOR X=1:1
- SET Y=$PIECE(IBSEL,",",X)
- if 'Y
- QUIT
- Begin DoDot:1
- +21 ;IB*2.0*618
- IF Y<8
- SET IB0=1
- QUIT
- +22 SET IB1=1
- End DoDot:1
- +23 if 'IBSEL
- GOTO ENQ
- SET IBSEL=","_IBSEL
- +24 ;
- +25 ; - Sort by division.
- +26 SET IBSDV=0
- IF IB0
- SET IBSDV=$$SDIV^IBJD()
- IF IBSDV["^"
- GOTO ENQ
- +27 ;
- +28 ; - Select a detailed or summary report.
- +29 DO DS^IBJD
- IF IBRPT["^"
- GOTO ENQ
- +30 ;
- +31 ;IB*2.0*618 - changed starting point from selection 4 to selection 8
- +32 ; Display receivables not sorting by division
- +33 IF IBSDV
- SET IB2=0
- FOR X=2:1
- SET Y=$PIECE(IBSEL,",",X)
- if 'Y
- QUIT
- Begin DoDot:1
- +34 ; Only display options 8-14
- +35 if Y<8
- QUIT
- +36 if Y>14
- QUIT
- +37 IF 'IB2
- Begin DoDot:2
- +38 WRITE !!,"NOTE: The receivables of these types will NOT be sorted by division:",!,*7
- End DoDot:2
- SET IB2=1
- +39 WRITE !?6,IBCTG(Y)
- End DoDot:1
- +40 ;end IB*2.0*618
- +41 ;
- +42 if IBRPT="S"
- GOTO DEV
- +43 ;
- +44 ; - Determine sorting (By name or Last 4 SSN)
- +45 SET (IBSN,X)=""
- +46 IF IB0
- Begin DoDot:1
- +47 SET IBSN=$$SNL^IBJD()
- if IBSN="^"
- QUIT
- +48 WRITE !!,"These receivables will be sorted by PATIENT/SSN:",!
- +49 FOR X=2:1
- SET Y=$PIECE(IBSEL,",",X)
- if 'Y
- QUIT
- IF Y<8
- WRITE !?6,IBCTG(Y)
- +50 ; - Determine the PATIENT range
- +51 SET X=$$INTV^IBJD("PATIENT "_$SELECT(IBSN="N":"NAME",1:"LAST 4"))
- if X="^"
- QUIT
- +52 SET IBSNF=$PIECE(X,"^",1)
- SET IBSNL=$PIECE(X,"^",2)
- SET IBSNA=$PIECE(X,"^",3)
- End DoDot:1
- IF IBSN="^"!(X="^")
- GOTO ENQ
- +53 ;
- +54 ; - Determine range of debtors.
- +55 IF 'IB1
- GOTO AGE
- +56 ;
- +57 IF IB1
- Begin DoDot:1
- +58 WRITE !!,"These receivables will be sorted by DEBTOR:",!
- +59 FOR X=2:1
- SET Y=$PIECE(IBSEL,",",X)
- if 'Y
- QUIT
- IF Y>4
- WRITE !?6,IBCTG(Y)
- End DoDot:1
- +60 SET VAUTD(0)=""
- +61 ;
- +62 ; - Determine the DEBTOR range
- +63 SET X=$$INTV^IBJD("DEBTOR")
- if X="^"
- GOTO ENQ
- +64 SET IBSDF=$PIECE(X,"^",1)
- SET IBSDL=$PIECE(X,"^",2)
- SET IBSDA=$PIECE(X,"^",3)
- +65 ;
- AGE ; - Determine if the active receivable must be within an age range.
- +1 WRITE !!,"Include (A)LL active AR's or those within an AGE (R)ANGE: ALL// "
- +2 READ X:DTIME
- if '$TEST!(X["^")
- GOTO ENQ
- if X=""
- SET X="A"
- SET X=$EXTRACT(X)
- +3 IF "ARar"'[X
- SET IBOFF=1
- DO HELP^IBJDF6H
- GOTO AGE
- +4 WRITE " ",$SELECT("Rr"[X:"RANGE",1:"ALL")
- +5 SET IBSMN=$SELECT("Rr"[X:"R",1:"A")
- if IBSMN="A"
- GOTO AMT
- +6 ;
- +7 ; - Determine the active receivable age range.
- +8 SET DIR(0)="NA^1:99999"
- +9 SET DIR("A")="Enter the minimum age of the active receivable: "
- +10 SET DIR("T")=DTIME
- SET DIR("?")="^S IBOFF=9 D HELP^IBJDF6H"
- +11 DO ^DIR
- KILL DIR
- if $DATA(DIRUT)!$DATA(DTOUT)!$DATA(DUOUT)!$DATA(DIROUT)
- GOTO ENQ
- +12 SET IBSMN=+Y
- WRITE " ",IBSMN," DAYS"
- KILL DIROUT,DTOUT,DUOUT,DIRUT
- +13 ;
- +14 SET DIR(0)="NA^"_IBSMN_":99999"
- SET DIR("B")=IBSMN
- +15 SET DIR("A")="Enter the maximum age of the active receivable: "
- +16 SET DIR("T")=DTIME
- SET DIR("?")="^S IBOFF=14 D HELP^IBJDF6H"
- +17 DO ^DIR
- KILL DIR
- if $DATA(DIRUT)!$DATA(DTOUT)!$DATA(DUOUT)!$DATA(DIROUT)
- GOTO ENQ
- +18 SET IBSMX=+Y
- WRITE " ",IBSMX," DAYS"
- KILL DIROUT,DTOUT,DUOUT,DIRUT
- +19 ;
- AMT ; - Print receivables with a minimum balance.
- +1 SET DIR(0)="Y"
- SET DIR("B")="NO"
- WRITE !
- +2 SET DIR("A")="Print receivables with a minimum balance"
- +3 SET DIR("T")=DTIME
- SET DIR("?")="^S IBOFF=19 D HELP^IBJDF6H"
- +4 DO ^DIR
- KILL DIR
- if $DATA(DIRUT)!$DATA(DTOUT)!$DATA(DUOUT)!$DATA(DIROUT)
- GOTO ENQ
- +5 SET IBSAM=+Y
- KILL DIROUT,DTOUT,DUOUT,DIRUT
- if 'IBSAM
- GOTO EXCEL
- +6 ;
- AMT1 ; - Determine the minimum balance amount.
- +1 SET DIR(0)="NA^1:9999999"
- +2 SET DIR("A")="Enter the minimum balance amount of the receivable: "
- +3 SET DIR("T")=DTIME
- SET DIR("?")="^S IBOFF=26 D HELP^IBJDF6H"
- +4 DO ^DIR
- KILL DIR
- if $DATA(DIRUT)!$DATA(DTOUT)!$DATA(DUOUT)!$DATA(DIROUT)
- GOTO ENQ
- +5 SET IBSAM=+Y
- KILL DIROUT,DTOUT,DUOUT,DIRUT
- +6 ;
- EXCEL ; - Determine whether to gather data for Excel report.
- +1 SET IBEXCEL=$$EXCEL^IBJD()
- if IBEXCEL="^"
- GOTO ENQ
- +2 IF IBEXCEL
- SET IBSH=1
- SET IBSH1="M"
- GOTO DEV
- +3 ;
- BCH ; - Determine whether to include the bill comment history.
- +1 SET DIR(0)="Y"
- SET DIR("B")="NO"
- WRITE !
- +2 SET DIR("A")="Include the bill comment history with each receivable"
- +3 SET DIR("T")=DTIME
- SET DIR("?")="^S IBOFF=31 D HELP^IBJDF6H"
- +4 DO ^DIR
- KILL DIR
- if $DATA(DIRUT)!$DATA(DTOUT)!$DATA(DUOUT)!$DATA(DIROUT)
- GOTO ENQ
- +5 SET IBSH=+Y
- KILL DIROUT,DTOUT,DUOUT,DIRUT
- if 'IBSH
- GOTO DEV
- +6 ;
- +7 SET DIR(0)="SA^A:ALL;M:MOST RECENT"
- +8 SET DIR("A")="Print (A)LL comments or the (M)OST RECENT comment: "
- +9 SET DIR("B")="ALL"
- SET DIR("T")=DTIME
- SET DIR("?")="^S IBOFF=40 D HELP^IBJDF6H"
- +10 DO ^DIR
- KILL DIR
- if $DATA(DIRUT)!$DATA(DTOUT)!$DATA(DUOUT)!$DATA(DIROUT)
- GOTO ENQ
- +11 SET IBSH1=Y
- KILL DIROUT,DTOUT,DUOUT,DIRUT
- if IBSH1="A"
- GOTO DEV
- +12 ;
- +13 SET DIR(0)="NAO^1:999"
- +14 SET DIR("A")="Minimum age of most recent bill comment (optional): "
- +15 SET DIR("T")=DTIME
- SET DIR("?")="^S IBOFF=47 D HELP^IBJDF6H"
- +16 DO ^DIR
- KILL DIR
- if $DATA(DTOUT)!$DATA(DUOUT)!$DATA(DIROUT)
- GOTO ENQ
- +17 SET IBSH2=+Y
- if IBSH2
- WRITE " DAYS"
- KILL DIROUT,DTOUT,DUOUT,DIRUT
- +18 ;
- DEV ; - Select a device.
- +1 KILL IB0,IB1,IB2
- +2 IF '$GET(IBEXCEL)
- Begin DoDot:1
- +3 SET X=$SELECT(IBRPT="S":80,1:132)
- +4 WRITE !!,"You will need a ",X," column printer for this report!",!
- +5 WRITE !,"Note: This report will search through all active receivables."
- +6 WRITE !," You should queue it to run after normal business hours.",!
- End DoDot:1
- +7 ;
- +8 IF $GET(IBEXCEL)
- DO EXMSG^IBJD
- +9 ;
- +10 WRITE !
- SET %ZIS="QM"
- DO ^%ZIS
- if POP
- GOTO ENQ
- +11 IF $DATA(IO("Q"))
- Begin DoDot:1
- +12 SET ZTRTN="DQ^IBJDF6"
- SET ZTDESC="IB - MISC. BILLS FOLLOW-UP REPORT"
- +13 FOR I="IB*","VAUTD","VAUTD("
- SET ZTSAVE(I)=""
- +14 DO ^%ZTLOAD
- +15 IF $DATA(ZTSK)
- WRITE !!,"This job has been queued. Task number is ",ZTSK,"."
- +16 IF '$TEST
- WRITE !!,"Unable to queue this job."
- +17 KILL ZTSK,IO("Q")
- DO HOME^%ZIS
- End DoDot:1
- GOTO ENQ
- +18 ;
- +19 USE IO
- +20 ;
- +21 ; If called by the Extraction Module, change extract status for the 3
- +22 ; reports: No-fault auto accident, Tort Feasor and Workman's Comp
- DQ IF $GET(IBXTRACT)
- FOR I=22:1:24
- DO E^IBJDE(I,1)
- +1 ;
- +2 ; Compile and print the report.
- DO ST^IBJDF61
- +3 ;
- ENQ KILL IBSDA,IBSDF,IBSDL,IBSDV,IBSEL,IBSN,IBSNA,IBSNF,IBSNL,IBSH,IBSH1,IBSH2
- +1 KILL IBCTG,IBCTS,IBOFF,IBPRT,IBRPT,IBSAM,IBSMN,IBSMX,IBTEXT,IBI,DIROUT
- +2 KILL DTOUT,DUOUT,DIRUT,POP,VAUTD,%ZIS,ZTDESC,ZTRTN,ZTSAVE,I,X,Y,Z
- +3 QUIT