IBJDF7.m

IBJDF7 ;ALB/MR - REPAYMENT PLAN REPORT;14-AUG-00

 ;;2.0;INTEGRATED BILLING;**123**;21-MAR-94

 ;

EN ; - Option entry point.

 S (IBEXCEL,IBTPT)=0,IBDAYS=1

 ;

 ; - Determine sorting (By name or Last 4 SSN)

 S IBSN=$$SNL^IBJD() G ENQ:IBSN="^"

 ;

 ; - Determine the range

 S X=$$INTV^IBJD("PATIENT "_$S(IBSN="N":"NAME",1:"LAST 4")) G ENQ:X="^"

 S IBSNF=$P(X,"^",1),IBSNL=$P(X,"^",2),IBSNA=$P(X,"^",3)

 ;

CDPP ; - Select Current or Defaulted Payment Plan

 S DIR(0)="SA^C:CURRENT;D:DEFAULTED;B:BOTH"

 S DIR("A")="Print (C)URRENT, (D)EFAULTED Repayment Plans or (B)OTH: "

 S DIR("B")="B",DIR("T")=300,DIR("L")=""

 S (DIR("?"),DIR("??"))="^S IBOFF=23 D HELP^IBJDF7H"

 W ! D ^DIR K DIR G:$D(DIRUT)!$D(DTOUT)!$D(DUOUT)!$D(DIROUT) ENQ

 S IBPLN=Y K DIROUT,DTOUT,DUOUT,DIRUT G MCR:IBPLN="C"

 ;

 ; - Minimum number of days defaulted

 S DIR(0)="NA^1:999",DIR("B")=1

 S DIR("A")="Minimum number of days defaulted: "

 S DIR("T")=300,DIR("?")="^S IBOFF=32 D HELP^IBJDF7H"

 W ! D ^DIR K DIR G:$D(DTOUT)!$D(DUOUT)!$D(DIROUT) ENQ

 S IBDAYS=+Y W:IBDAYS " day(s)" K DIROUT,DTOUT,DUOUT

 ;

MCR ; - Select MCCR or NON-MCCR Receivables

 S DIR(0)="SA^M:MCCR;N:NON-MCCR"

 S DIR("A")="Print (M)CCR or (N)ON-MCCR Receivables: "

 S DIR("B")="M",DIR("T")=300,DIR("L")=""

 S (DIR("?"),DIR("??"))="^S IBOFF=39 D HELP^IBJDF7H"

 W ! D ^DIR K DIR G:$D(DIRUT)!$D(DTOUT)!$D(DUOUT)!$D(DIROUT) ENQ

 S IBMCR=Y K DIROUT,DTOUT,DUOUT,DIRUT

 ;

 ; - Select a detailed or summary report.

 D DS^IBJD G ENQ:IBRPT["^",DEV:IBRPT="S"

 ;

 ; - Determine whether to gather data for Excel report.

 S IBEXCEL=$$EXCEL^IBJD() G ENQ:IBEXCEL="^",DEV:IBEXCEL

 ;

 ; - Print TOTAL by Patient?

 S DIR(0)="Y",DIR("B")="YES",DIR("T")=300 W !

 S DIR("A")="Do you want to include TOTALs by Patient"

 S DIR("?")="^S IBOFF=55 D HELP^IBJDF7H"

 D ^DIR K DIR G:$D(DIRUT)!$D(DTOUT)!$D(DUOUT)!$D(DIROUT) ENQ

 S IBTPT=+Y K DIROUT,DTOUT,DUOUT,DIRUT

 ;

DEV ; - Select a device.

 W !!,"This report requires a ",$S(IBRPT="S":80,1:132)," column printer."

 ;

 I '$G(IBEXCEL) D

 . W !!,"Note: This report will search through all active receivables."

 . W !?6,"It is recommended that you queue it to run after normal business hours.",!

 ;

 I $G(IBEXCEL) D EXMSG^IBJD

 ;

 S %ZIS="QM" D ^%ZIS G:POP ENQ

 I $D(IO("Q")) D  G ENQ

 .S ZTRTN="DQ^IBJDF7",ZTDESC="IB - REPAYMENT PLAN REPORT"

 .S ZTSAVE("IB*")="" D ^%ZTLOAD

 .I $G(ZTSK) W !!,"This job has been queued. The task no. is ",ZTSK,"."

 .E  W !!,"Unable to queue this job."

 .K ZTSK,IO("Q") D HOME^%ZIS

 ;

 U IO

 ;

DQ I $G(IBXTRACT) D E^IBJDE(38,1) ;  Change extract status.

 D ST^IBJDF71 ;                  Compile and print the report.

 ;

ENQ K DIROUT,DTOUT,DUOUT,DIRUT,I,IBDAYS,IBEXCEL,IBI,IBMCR,IBSN,IBSNF,IBSNL

 K IBOFF,IBSNA,IBPLN,IBRPT,IBTPT,POP,X,ZTDESC,ZTRTN,ZTSAVE,Y,%ZIS

 Q

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---IBJDF7   2822     printed  Mar 13, 2025@21:28                                                                                                                                                                                                         Page 2

IBJDF7    ;ALB/MR - REPAYMENT PLAN REPORT;14-AUG-00

 +1       ;;2.0;INTEGRATED BILLING;**123**;21-MAR-94

 +2       ;

EN        ; - Option entry point.

 +1        SET (IBEXCEL,IBTPT)=0

           SET IBDAYS=1

 +2       ;

 +3       ; - Determine sorting (By name or Last 4 SSN)

 +4        SET IBSN=$$SNL^IBJD()

           if IBSN="^"

               GOTO ENQ

 +5       ;

 +6       ; - Determine the range

 +7        SET X=$$INTV^IBJD("PATIENT "_$SELECT(IBSN="N":"NAME",1:"LAST 4"))

           if X="^"

               GOTO ENQ

 +8        SET IBSNF=$PIECE(X,"^",1)

           SET IBSNL=$PIECE(X,"^",2)

           SET IBSNA=$PIECE(X,"^",3)

 +9       ;

CDPP      ; - Select Current or Defaulted Payment Plan

 +1        SET DIR(0)="SA^C:CURRENT;D:DEFAULTED;B:BOTH"

 +2        SET DIR("A")="Print (C)URRENT, (D)EFAULTED Repayment Plans or (B)OTH: "

 +3        SET DIR("B")="B"

           SET DIR("T")=300

           SET DIR("L")=""

 +4        SET (DIR("?"),DIR("??"))="^S IBOFF=23 D HELP^IBJDF7H"

 +5        WRITE !

           DO ^DIR

           KILL DIR

           if $DATA(DIRUT)!$DATA(DTOUT)!$DATA(DUOUT)!$DATA(DIROUT)

               GOTO ENQ

 +6        SET IBPLN=Y

           KILL DIROUT,DTOUT,DUOUT,DIRUT

           if IBPLN="C"

               GOTO MCR

 +7       ;

 +8       ; - Minimum number of days defaulted

 +9        SET DIR(0)="NA^1:999"

           SET DIR("B")=1

 +10       SET DIR("A")="Minimum number of days defaulted: "

 +11       SET DIR("T")=300

           SET DIR("?")="^S IBOFF=32 D HELP^IBJDF7H"

 +12       WRITE !

           DO ^DIR

           KILL DIR

           if $DATA(DTOUT)!$DATA(DUOUT)!$DATA(DIROUT)

               GOTO ENQ

 +13       SET IBDAYS=+Y

           if IBDAYS

               WRITE " day(s)"

           KILL DIROUT,DTOUT,DUOUT

 +14      ;

MCR       ; - Select MCCR or NON-MCCR Receivables

 +1        SET DIR(0)="SA^M:MCCR;N:NON-MCCR"

 +2        SET DIR("A")="Print (M)CCR or (N)ON-MCCR Receivables: "

 +3        SET DIR("B")="M"

           SET DIR("T")=300

           SET DIR("L")=""

 +4        SET (DIR("?"),DIR("??"))="^S IBOFF=39 D HELP^IBJDF7H"

 +5        WRITE !

           DO ^DIR

           KILL DIR

           if $DATA(DIRUT)!$DATA(DTOUT)!$DATA(DUOUT)!$DATA(DIROUT)

               GOTO ENQ

 +6        SET IBMCR=Y

           KILL DIROUT,DTOUT,DUOUT,DIRUT

 +7       ;

 +8       ; - Select a detailed or summary report.

 +9        DO DS^IBJD

           if IBRPT["^"

               GOTO ENQ

           if IBRPT="S"

               GOTO DEV

 +10      ;

 +11      ; - Determine whether to gather data for Excel report.

 +12       SET IBEXCEL=$$EXCEL^IBJD()

           if IBEXCEL="^"

               GOTO ENQ

           if IBEXCEL

               GOTO DEV

 +13      ;

 +14      ; - Print TOTAL by Patient?

 +15       SET DIR(0)="Y"

           SET DIR("B")="YES"

           SET DIR("T")=300

           WRITE !

 +16       SET DIR("A")="Do you want to include TOTALs by Patient"

 +17       SET DIR("?")="^S IBOFF=55 D HELP^IBJDF7H"

 +18       DO ^DIR

           KILL DIR

           if $DATA(DIRUT)!$DATA(DTOUT)!$DATA(DUOUT)!$DATA(DIROUT)

               GOTO ENQ

 +19       SET IBTPT=+Y

           KILL DIROUT,DTOUT,DUOUT,DIRUT

 +20      ;

DEV       ; - Select a device.

 +1        WRITE !!,"This report requires a ",$SELECT(IBRPT="S":80,1:132)," column printer."

 +2       ;

 +3        IF '$GET(IBEXCEL)

               Begin DoDot:1

 +4                WRITE !!,"Note: This report will search through all active receivables."

 +5                WRITE !?6,"It is recommended that you queue it to run after normal business hours.",!

               End DoDot:1

 +6       ;

 +7        IF $GET(IBEXCEL)

               DO EXMSG^IBJD

 +8       ;

 +9        SET %ZIS="QM"

           DO ^%ZIS

           if POP

               GOTO ENQ

 +10       IF $DATA(IO("Q"))

               Begin DoDot:1

 +11               SET ZTRTN="DQ^IBJDF7"

                   SET ZTDESC="IB - REPAYMENT PLAN REPORT"

 +12               SET ZTSAVE("IB*")=""

                   DO ^%ZTLOAD

 +13               IF $GET(ZTSK)

                       WRITE !!,"This job has been queued. The task no. is ",ZTSK,"."

 +14              IF '$TEST

                       WRITE !!,"Unable to queue this job."

 +15               KILL ZTSK,IO("Q")

                   DO HOME^%ZIS

               End DoDot:1

               GOTO ENQ

 +16      ;

 +17       USE IO

 +18      ;

DQ        ;  Change extract status.

           IF $GET(IBXTRACT)

               DO E^IBJDE(38,1)

 +1       ;                  Compile and print the report.

           DO ST^IBJDF71

 +2       ;

ENQ        KILL DIROUT,DTOUT,DUOUT,DIRUT,I,IBDAYS,IBEXCEL,IBI,IBMCR,IBSN,IBSNF,IBSNL

 +1        KILL IBOFF,IBSNA,IBPLN,IBRPT,IBTPT,POP,X,ZTDESC,ZTRTN,ZTSAVE,Y,%ZIS

 +2        QUIT