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
Q
;
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
Q
;
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
Q
;
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
Q
;
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))
Q
;
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
Q
;
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.
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBCEMSRP 2732 printed Apr 09, 2024@21:19:33 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 ;
