Routine: IBCEMSRP

IBCEMSRP ;ALB/VAD - IB PRINTED CLAIMS REPORT ;09-SEP-2015

 ;;2.0;INTEGRATED BILLING;**547**;21-MAR-94;Build 119

 ;;Per VA Directive 6402, this routine should not be modified.

 ; access to ^DG(40.8 allowed with DBIA#417

EN ;

 N IBQ,IBCOT,IBDIVS,IBBDT,IBEDT,IBSORT

 S IBQ=0 ; quit flag

 ; Prompts to the user:

 D COT Q:IBQ  ; (C)PAC or (T)RICARE/CHAMPVA

 D DIVS Q:IBQ  ; Division(s)

 D DTR Q:IBQ  ; From-To date range

 D SORTBY Q:IBQ  ; Sort By?

 W !!,"Report requires 132 Columns"

 D DEVICE Q:IBQ

 D RUN

COT N DIR,DIRUT,Y

 W ! S DIR(0)="SAO^C:(C)PAC;T:(T)RICARE/CHAMPVA"

 S DIR("A")="RUN for (C)PAC or (T)RICARE/CHAMPVA: ",DIR("B")="C" D ^DIR

 I $D(DIRUT) S IBQ=1 Q

 S IBCOT=Y

DIVS N DIC,DIR,DIRUT,Y,X,IBDIV,IBDVN

 W ! S DIR("B")="ALL",DIR("A")="Run this report for All divisions or Selected Divisions: "

 S DIR(0)="SA^ALL:All divisions;S:Selected divisions" D ^DIR

 I $D(DIRUT) S IBQ=1 Q

 ; if user selects all divisions, gather names and iens (DBIA#417)

 I X="ALL" S IBDIVS("ALL")=1 D  Q

 .S IBDIVS(0)="UNKNOWN"  ; older claims may not have a division

 .S IBDIV="" F  S IBDIV=$O(^DG(40.8,"B",IBDIV)) Q:IBDIV=""  D

 ..S IBDVN="" F  S IBDVN=$O(^DG(40.8,"B",IBDIV,IBDVN)) Q:'IBDVN  D

 ...S IBDIVS(+IBDVN)=IBDIV

 ; Collect divisions

 F  D  Q:Y'>0

 . W ! S DIC("A")="Division: ",DIC=40.8,DIC(0)="AEQM" D ^DIC

 . I $D(DIRUT) S IBQ=1 Q

 . I Y'>0 Q

 . S IBDIVS(+Y)=$P(Y,U,2)

 I '$D(IBDIVS)  S IBQ=1 Q  ; None selected

DTR ;date range

 N %DT,Y

 S IBBDT=DT-7,IBEDT=DT

 S %DT="AEX"

 S %DT("A")="Earliest Printed Date: ",%DT("B")="T-7"

 W ! D ^%DT K %DT

 I Y<0 S IBQ=1 Q

 S IBBDT=+Y

 S %DT="AEX"

 S %DT("A")="Latest Printed Date: ",%DT("B")="T"

 D ^%DT K %DT

 I Y<0 S IBQ=1 Q

 S IBEDT=+Y

SORTBY ;

 N DIR,DTOUT,DUOUT

 S DIR(0)="SBMA^I:Insurance Company;B:Authorizing Biller;R:Rate Type;F:Form Type;P:Type of Plan"

 S DIR("A")="Sort Report By: ",DIR("B")="Authorizing Biller"

 S DIR("?")=" ",DIR("?",1)="This determines the criteria by which the claims will"

 S DIR("?",2)="be displayed." D ^DIR K DIR

 Q:$D(DTOUT)!($D(DUOUT))

 S IBSORT=Y_U_$G(Y(0))

DEVICE ; Get the Output Device.

 N %ZIS,ZTRTN,ZTDESC,ZTSAVE,POP

 K IO("Q")

 S %ZIS="QM" W ! D ^%ZIS I POP S IBQ=1 Q

 I $D(IO("Q")) D  S IBQ=1 Q

 . S ZTRTN="RUN^IBCEMSRP",ZTDESC="IB PRINTED CLAIMS REPORT"

 . S ZTSAVE("IBBDT")="",ZTSAVE("IBEDT")="",ZTSAVE("IBCOT")="",ZTSAVE("IBSORT")="",ZTSAVE("IBDIVS(")=""

 . D ^%ZTLOAD

 . D HOME^%ZIS

RUN ; Begin the execution of the report.

 D SRCH^IBCEMSR6  ; Search, Sort and Store the data based upon the criteria that was entered by the user.

 U IO

 D REPORT^IBCEMSR7    ; Print the report from the formatted array.

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBCEMSRP   2732     printed  Feb 18, 2025@23:37:36                                                                                                                                                                                                    Page 2

IBCEMSRP  ;ALB/VAD - IB PRINTED CLAIMS REPORT ;09-SEP-2015

 +1       ;;2.0;INTEGRATED BILLING;**547**;21-MAR-94;Build 119

 +2       ;;Per VA Directive 6402, this routine should not be modified.

 +3       ;

 +4       ; access to ^DG(40.8 allowed with DBIA#417

 +5       ;

EN        ;

 +1        NEW IBQ,IBCOT,IBDIVS,IBBDT,IBEDT,IBSORT

 +2       ; quit flag

           SET IBQ=0

 +3       ; Prompts to the user:

 +4       ; (C)PAC or (T)RICARE/CHAMPVA

           DO COT

           if IBQ

               QUIT

 +5       ; Division(s)

           DO DIVS

           if IBQ

               QUIT

 +6       ; From-To date range

           DO DTR

           if IBQ

               QUIT

 +7       ; Sort By?

           DO SORTBY

           if IBQ

               QUIT

 +8        WRITE !!,"Report requires 132 Columns"

 +9        DO DEVICE

           if IBQ

               QUIT

 +10       DO RUN

 +11       QUIT

 +12      ;

COT        NEW DIR,DIRUT,Y

 +1        WRITE !

           SET DIR(0)="SAO^C:(C)PAC;T:(T)RICARE/CHAMPVA"

 +2        SET DIR("A")="RUN for (C)PAC or (T)RICARE/CHAMPVA: "

           SET DIR("B")="C"

           DO ^DIR

 +3        IF $DATA(DIRUT)

               SET IBQ=1

               QUIT

 +4        SET IBCOT=Y

 +5        QUIT

 +6       ;

DIVS       NEW DIC,DIR,DIRUT,Y,X,IBDIV,IBDVN

 +1        WRITE !

           SET DIR("B")="ALL"

           SET DIR("A")="Run this report for All divisions or Selected Divisions: "

 +2        SET DIR(0)="SA^ALL:All divisions;S:Selected divisions"

           DO ^DIR

 +3        IF $DATA(DIRUT)

               SET IBQ=1

               QUIT

 +4       ; if user selects all divisions, gather names and iens (DBIA#417)

 +5        IF X="ALL"

               SET IBDIVS("ALL")=1

               Begin DoDot:1

 +6       ; older claims may not have a division

                   SET IBDIVS(0)="UNKNOWN"

 +7                SET IBDIV=""

FOR

                       SET IBDIV=$ORDER(^DG(40.8,"B",IBDIV))

                       if IBDIV=""

                           QUIT

                       Begin DoDot:2

 +8                        SET IBDVN=""

FOR

                               SET IBDVN=$ORDER(^DG(40.8,"B",IBDIV,IBDVN))

                               if 'IBDVN

                                   QUIT

                               Begin DoDot:3

 +9                                SET IBDIVS(+IBDVN)=IBDIV

                               End DoDot:3

                       End DoDot:2

               End DoDot:1

               QUIT

 +10      ; Collect divisions

 +11       FOR

               Begin DoDot:1

 +12               WRITE !

                   SET DIC("A")="Division: "

                   SET DIC=40.8

                   SET DIC(0)="AEQM"

                   DO ^DIC

 +13               IF $DATA(DIRUT)

                       SET IBQ=1

                       QUIT

 +14               IF Y'>0

                       QUIT

 +15               SET IBDIVS(+Y)=$PIECE(Y,U,2)

               End DoDot:1

               if Y'>0

                   QUIT

 +16      ; None selected

           IF '$DATA(IBDIVS)

               SET IBQ=1

               QUIT

 +17       QUIT

 +18      ;

DTR       ;date range

 +1        NEW %DT,Y

 +2        SET IBBDT=DT-7

           SET IBEDT=DT

 +3        SET %DT="AEX"

 +4        SET %DT("A")="Earliest Printed Date: "

           SET %DT("B")="T-7"

 +5        WRITE !

           DO ^%DT

           KILL %DT

 +6        IF Y<0

               SET IBQ=1

               QUIT

 +7        SET IBBDT=+Y

 +8        SET %DT="AEX"

 +9        SET %DT("A")="Latest Printed Date: "

           SET %DT("B")="T"

 +10       DO ^%DT

           KILL %DT

 +11       IF Y<0

               SET IBQ=1

               QUIT

 +12       SET IBEDT=+Y

 +13       QUIT

 +14      ;

SORTBY    ;

 +1        NEW DIR,DTOUT,DUOUT

 +2        SET DIR(0)="SBMA^I:Insurance Company;B:Authorizing Biller;R:Rate Type;F:Form Type;P:Type of Plan"

 +3        SET DIR("A")="Sort Report By: "

           SET DIR("B")="Authorizing Biller"

 +4        SET DIR("?")=" "

           SET DIR("?",1)="This determines the criteria by which the claims will"

 +5        SET DIR("?",2)="be displayed."

           DO ^DIR

           KILL DIR

 +6        if $DATA(DTOUT)!($DATA(DUOUT))

               QUIT

 +7        SET IBSORT=Y_U_$GET(Y(0))

 +8        QUIT

 +9       ;

DEVICE    ; Get the Output Device.

 +1        NEW %ZIS,ZTRTN,ZTDESC,ZTSAVE,POP

 +2        KILL IO("Q")

 +3        SET %ZIS="QM"

           WRITE !

           DO ^%ZIS

           IF POP

               SET IBQ=1

               QUIT

 +4       ;

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

               Begin DoDot:1

 +6                SET ZTRTN="RUN^IBCEMSRP"

                   SET ZTDESC="IB PRINTED CLAIMS REPORT"

 +7                SET ZTSAVE("IBBDT")=""

                   SET ZTSAVE("IBEDT")=""

                   SET ZTSAVE("IBCOT")=""

                   SET ZTSAVE("IBSORT")=""

                   SET ZTSAVE("IBDIVS(")=""

 +8                DO ^%ZTLOAD

 +9                DO HOME^%ZIS

               End DoDot:1

               SET IBQ=1

               QUIT

 +10       QUIT

 +11      ;

RUN       ; Begin the execution of the report.

 +1       ; Search, Sort and Store the data based upon the criteria that was entered by the user.

           DO SRCH^IBCEMSR6

 +2        USE IO

 +3       ; Print the report from the formatted array.

           DO REPORT^IBCEMSR7

 +4        QUIT

 +5       ;

IBCEMSRP.m