IBCEM4 ;ALB/TMP - IB ELECTRONIC MESSAGE SCREEN TEXT MAINT ;19-APR-2001
;;2.0;INTEGRATED BILLING;**137,368**;21-MAR-1994;Build 21
;;Per VHA Directive 2004-038, this routine should not be modified.
;
EN ; entry point for maintenance
D EN^VALM("IBCE MESSAGE TEXT MAIN")
Q
;
HDR ; Header code
K VALMHDR
Q
;
INIT ; Build list of text entries
N Z,Z0
S (IBCNT,VALMCNT)=0,VALMBG=1
K ^TMP("IBCEMSGT",$J)
S Z="" F S Z=$O(^IBE(361.3,"AC",Z),-1) Q:Z="" D SET(Z) S Z0="" F S Z0=$O(^IBE(361.3,"AC",Z,Z0)) Q:Z0="" D SET(Z,Z0)
Q
;
EXIT ; -- Clean up list
K ^TMP("IBCEMSGT",$J)
D CLEAN^VALM10
Q
;
SET(Z,Z0) ; Set data into display global
N X,IB
S IBCNT=IBCNT+1,X="",IB=""
S:$G(Z0)'="" Z0=" "_Z0
I $G(Z0)="" D
. S Z0=$S('Z:"*** DO NOT REQUIRE REVIEW ***",1:"*** REQUIRE REVIEW ***"),IB=$J("",(80-$L(Z0))\2),Z0=IB_Z0
. I 'Z D SET(Z," ")
I Z0'="" S X=$$SETFLD^VALM1(Z0,X,"TEXT")
S VALMCNT=VALMCNT+1,^TMP("IBCEMSGT",$J,VALMCNT,0)=X
S ^TMP("IBCEMSGT",$J,"IDX",VALMCNT,IBCNT)=""
I IB'="" D CNTRL^VALM10(VALMCNT,2+$L(IB),$L(Z0)-$L(IB),IORVON,IORVOFF)
Q
EDIT ; Add/edit message text
N DA,DIC,DLAYGO,DIE,DR,DIR,X,Y,IBUPD,IBSTOP,IBY
D FULL^VALM1
S (IBSTOP,IBUPD)=0
F D Q:IBSTOP
. S DIC(0)="AELMQ",DLAYGO=361.3,DIC="^IBE(361.3,",DIC("DR")="@1;.02;I X="""" W !,""MUST HAVE A VALUE FOR THIS FIELD"" S Y=""@1""" W ! D ^DIC
. S IBY=Y
. I IBY'>0 S IBSTOP=1 Q
. I $P(IBY,U,3) S IBUPD=1 Q
. S DIC="^IBE(361.3,",DA=+IBY W ! D EN^DIQ W !
. S DIE="^IBE(361.3,",DA=+IBY,DR=".01" D ^DIE ; edit
. I '$D(^IBE(361.3,+IBY,0)) S IBUPD=1 Q
. I $P(IBY,U,2)'=$P(^IBE(361.3,+IBY,0),U) S IBUPD=1,DIE="^IBE(361.3,",DR=".05////"_$G(DUZ)_";.06///^S X=""NOW""" D ^DIE
D:IBUPD INIT
S VALMBCK="R"
Q
;
CKREVU(IBTEXT,IBNR,IBSKIP,IBREV) ; Check IBTEXT contains 'no review
; needed' text
; IBNR = returned if passed by reference - 'no review needed' text found
; IBSKIP = 1 if no check needed for 'always review'
; IBREV = returned if passed by reference and 'review always needed'
; text found
;
N T,Y,Z,Z0
S (IBREV,Y)=0,Z="",IBTEXT=$$UP^XLFSTR($G(IBTEXT))
I '$G(IBSKIP) F S Z=$O(^IBE(361.3,"AC",1,Z)) Q:Z="" I IBTEXT[$$UP^XLFSTR(Z) S IBREV=1 Q ; Always review messages with this text
I 'IBREV S Z="" F S Z=$O(^IBE(361.3,"AC",0,Z)) Q:Z="" I IBTEXT[$$UP^XLFSTR(Z) S Y=1,IBNR=Z Q ; Message contains text to make review unnecessary
Q Y
;
REPORT ; Produce a report of messages filed without review by user-selected
; date range for date received and sort by either bill# or message text
N IBFR,IBTO,IBSORT,DIR,DA,DR,X,Y,ZTSAVE,ZTRTN,ZTDESC,ZTREQ
R1 S DIR("A")="FROM DATE RECEIVED: ",DIR(0)="DA^:"_DT_"::PAXE" D ^DIR K DIR
Q:$D(DTOUT)!$D(DUOUT)
S IBFR=Y W " ",$G(Y(0))
R2 S DIR("A")="TO DATE RECEIVED: ",DIR(0)="DAO^"_IBFR_":"_DT_"::PAE" D ^DIR K DIR
Q:$D(DTOUT)!$D(DUOUT)
I Y'>0 W ! G R1
S IBTO=Y W " ",$G(Y(0))
S DIR("A")="SORT BY",DIR(0)="SXBO^B:Bill #;M:Message Screen Text",DIR("B")="B" D ^DIR K DIR
Q:$D(DTOUT)!$D(DUOUT)
I (Y="")!("BM"'[Y) W ! G R2
S IBSORT=Y
S %ZIS="QM" D ^%ZIS Q:POP
I $D(IO("Q")) K IO("Q") S ZTRTN="ENRPT^IBCEM4",ZTSAVE("IB*")="",ZTDESC="IB - MESSAGES FILED WITHOUT REVIEW REPORT" D ^%ZTLOAD K ZTSK D HOME^%ZIS Q
U IO
ENRPT ; Queued job entrypoint
N IB,IB0,IBDA,IB00,IB1,IBS1,IBPAGE,IBLINES,IBHDRDT,IBSB,IBSTOP,DIR,Y,X,Z
W:$E(IOST,1,2)["C-" @IOF ;Only initial form feed for print to screen
K ^TMP($J,"IBSORT")
S IB=IBFR-.000001
F S IB=$O(^IBM(361,"ARD",IB)) Q:'IB!$G(ZTSTOP) S IBDA=0 F S IBDA=$O(^IBM(361,"ARD",IB,IBDA)) Q:'IBDA!$G(ZTSTOP) S IB0=$G(^IBM(361,IBDA,0)) Q:IB0=""!'$P(IB0,U,14) D
. I $D(ZTQUEUED) Q:$$STOP(.ZTREQ,.ZTSTOP)
. S IBS1=""
. I IBSORT="M" D ; Find text that caused auto-file
.. S Z=0 F S Z=$O(^IBM(361,IBDA,1,Z)) Q:'Z I $$CKREVU($G(^IBM(361,IBDA,1,Z,0)),.IBS1,1) Q
.. I IBS1="" S IBS1="??"
. I IBSORT="B" S IBS1=$P($G(^DGCR(399,+IB0,0)),U)
. I IBS1'="" S ^TMP($J,"IBSORT",IBS1,IBDA)=IB0
S IBHDRDT=$$FMTE^XLFDT($$NOW^XLFDT(),"2P")
S (IBSTOP,IBLINES,IBPAGE)=0
S IB1=1,IB="" F S IB=$O(^TMP($J,"IBSORT",IB)) Q:IB=""!$G(ZTSTOP) D Q:IBSTOP
. S IBSB=$S(IBSORT="M":"MESSAGE SCREEN TEXT: "_IB,1:"")
. I IBSB'="" S IBSB=$J("",(80-$L(IBSB)\2))_IBSB
. D:IB1 RHDR(IBSB,.IBSTOP) Q:IBSTOP
. I 'IB1,IBSORT="M" D Q:IBSTOP
.. I IBLINES>(IOSL-5) D RHDR(IBSB,.IBSTOP) Q
.. W !!,IBSB,! S IBLINES=IBLINES+3
. S (IB1,IBDA)=0 F S IBDA=$O(^TMP($J,"IBSORT",IB,IBDA)) Q:'IBDA!$G(ZTSTOP) D Q:IBSTOP
.. I $D(ZTQUEUED),$$STOP(.ZTREQ,.ZTSTOP) W !,"*********** REPORT STOPPED BEFORE IT COMPLETED!!! ***********" Q
.. S IB0=$G(^TMP($J,"IBSORT",IB,IBDA)),IB00=$G(^DGCR(399,+IB0,0))
.. I $G(IBLINES)>(IOSL-5) D RHDR("",.IBSTOP) Q:IBSTOP
.. W !,$E($$BN1^PRCAFN(+IB0)_$J("",10),1,10)," ",$E($P($G(^DPT(+$P(IB00,U,2),0)),U)_$J("",25),1,25)_" "_$E($$FMTE^XLFDT($P(IB00,U,3),"2D")_$J("",8),1,8)_" "_$E($$FMTE^XLFDT($P(IB0,U,2),"2D")_$J("",8),1,8)_" "
.. W $E($P($G(^DIC(36,+$$POLICY^IBCEF(+IB0,1,$P(IB0,U,7)),0)),U),1,20)
.. S IBLINES=IBLINES+1
.. I $G(IBLINES)>(IOSL-5) D RHDR("",.IBSTOP) Q:IBSTOP
.. S Z=0 F S Z=$O(^IBM(361,IBDA,1,Z)) Q:'Z D Q:IBSTOP
... N Z0,Z1
... S Z0=$G(^IBM(361,IBDA,1,Z,0))
... F Z1=1:75:$L(Z0) D:$G(IBLINES)>(IOSL-5) RHDR("",.IBSTOP) Q:IBSTOP W !,?5,$E(Z0,Z1,Z1+74) S IBLINES=IBLINES+1
G:IBSTOP!$G(ZTSTOP) ENSTOP
I $G(IB1) D RHDR("") W !,"NO RECORDS MATCHING SEARCH CRITERIA WERE FOUND",!
;
I $E(IOST,1,2)["C-" K DIR S DIR(0)="E" D ^DIR K DIR
ENSTOP I '$D(ZTQUEUED) D ^%ZISC
I $D(ZTQUEUED),'$G(ZTSTOP) S ZTREQ="@"
K ^TMP($J,"IBSORT")
Q
;
RHDR(IBSB,IBSTOP) ; Report header
; IBSB'="" if sub header should print
N Z,DIR,X,Y
S IBPAGE=IBPAGE+1
I IBPAGE>1,$E(IOST,1,2)["C-" S DIR(0)="E" D ^DIR K DIR I $D(DTOUT)!$D(DUOUT) S IBSTOP=1 G RHDRQ
W !,@IOF
W !,?22,"MESSAGES FILED WITHOUT REVIEW REPORT",?65,"PAGE: ",IBPAGE
S Z="RUN DATE: "_IBHDRDT W !,?(80-$L(Z)\2),Z
S Z="DATE RECEIVED RANGE: "_$$FMTE^XLFDT(IBFR,"2D")_"-"_$$FMTE^XLFDT(IBTO,"2D") W !,?(80-$L(Z)\2),Z,!
W !,$J("",40),"EVENT DATE"
W !,"BILL # PATIENT NAME"_$J("",15)_" DATE RECEIVED INSURANCE CO",!
S Z="",$P(Z,"-",81)="" W Z
S IBLINES=7
I $G(IBSB)'="" W !,IBSB,! S IBLINES=IBLINES+2
RHDRQ Q
;
STOP(IBSTOP,IBREQ) ; Check for job being stopped
I $$S^%ZTLOAD S IBSTOP=1 K IBREQ
Q $G(IBSTOP)
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBCEM4 6365 printed Apr 09, 2024@21:08:46 Page 2
IBCEM4 ;ALB/TMP - IB ELECTRONIC MESSAGE SCREEN TEXT MAINT ;19-APR-2001
+1 ;;2.0;INTEGRATED BILLING;**137,368**;21-MAR-1994;Build 21
+2 ;;Per VHA Directive 2004-038, this routine should not be modified.
+3 ;
EN ; entry point for maintenance
+1 DO EN^VALM("IBCE MESSAGE TEXT MAIN")
+2 QUIT
+3 ;
HDR ; Header code
+1 KILL VALMHDR
+2 QUIT
+3 ;
INIT ; Build list of text entries
+1 NEW Z,Z0
+2 SET (IBCNT,VALMCNT)=0
SET VALMBG=1
+3 KILL ^TMP("IBCEMSGT",$JOB)
+4 SET Z=""
FOR
SET Z=$ORDER(^IBE(361.3,"AC",Z),-1)
if Z=""
QUIT
DO SET(Z)
SET Z0=""
FOR
SET Z0=$ORDER(^IBE(361.3,"AC",Z,Z0))
if Z0=""
QUIT
DO SET(Z,Z0)
+5 QUIT
+6 ;
EXIT ; -- Clean up list
+1 KILL ^TMP("IBCEMSGT",$JOB)
+2 DO CLEAN^VALM10
+3 QUIT
+4 ;
SET(Z,Z0) ; Set data into display global
+1 NEW X,IB
+2 SET IBCNT=IBCNT+1
SET X=""
SET IB=""
+3 if $GET(Z0)'=""
SET Z0=" "_Z0
+4 IF $GET(Z0)=""
Begin DoDot:1
+5 SET Z0=$SELECT('Z:"*** DO NOT REQUIRE REVIEW ***",1:"*** REQUIRE REVIEW ***")
SET IB=$JUSTIFY("",(80-$LENGTH(Z0))\2)
SET Z0=IB_Z0
+6 IF 'Z
DO SET(Z," ")
End DoDot:1
+7 IF Z0'=""
SET X=$$SETFLD^VALM1(Z0,X,"TEXT")
+8 SET VALMCNT=VALMCNT+1
SET ^TMP("IBCEMSGT",$JOB,VALMCNT,0)=X
+9 SET ^TMP("IBCEMSGT",$JOB,"IDX",VALMCNT,IBCNT)=""
+10 IF IB'=""
DO CNTRL^VALM10(VALMCNT,2+$LENGTH(IB),$LENGTH(Z0)-$LENGTH(IB),IORVON,IORVOFF)
+11 QUIT
EDIT ; Add/edit message text
+1 NEW DA,DIC,DLAYGO,DIE,DR,DIR,X,Y,IBUPD,IBSTOP,IBY
+2 DO FULL^VALM1
+3 SET (IBSTOP,IBUPD)=0
+4 FOR
Begin DoDot:1
+5 SET DIC(0)="AELMQ"
SET DLAYGO=361.3
SET DIC="^IBE(361.3,"
SET DIC("DR")="@1;.02;I X="""" W !,""MUST HAVE A VALUE FOR THIS FIELD"" S Y=""@1"""
WRITE !
DO ^DIC
+6 SET IBY=Y
+7 IF IBY'>0
SET IBSTOP=1
QUIT
+8 IF $PIECE(IBY,U,3)
SET IBUPD=1
QUIT
+9 SET DIC="^IBE(361.3,"
SET DA=+IBY
WRITE !
DO EN^DIQ
WRITE !
+10 ; edit
SET DIE="^IBE(361.3,"
SET DA=+IBY
SET DR=".01"
DO ^DIE
+11 IF '$DATA(^IBE(361.3,+IBY,0))
SET IBUPD=1
QUIT
+12 IF $PIECE(IBY,U,2)'=$PIECE(^IBE(361.3,+IBY,0),U)
SET IBUPD=1
SET DIE="^IBE(361.3,"
SET DR=".05////"_$GET(DUZ)_";.06///^S X=""NOW"""
DO ^DIE
End DoDot:1
if IBSTOP
QUIT
+13 if IBUPD
DO INIT
+14 SET VALMBCK="R"
+15 QUIT
+16 ;
CKREVU(IBTEXT,IBNR,IBSKIP,IBREV) ; Check IBTEXT contains 'no review
+1 ; needed' text
+2 ; IBNR = returned if passed by reference - 'no review needed' text found
+3 ; IBSKIP = 1 if no check needed for 'always review'
+4 ; IBREV = returned if passed by reference and 'review always needed'
+5 ; text found
+6 ;
+7 NEW T,Y,Z,Z0
+8 SET (IBREV,Y)=0
SET Z=""
SET IBTEXT=$$UP^XLFSTR($GET(IBTEXT))
+9 ; Always review messages with this text
IF '$GET(IBSKIP)
FOR
SET Z=$ORDER(^IBE(361.3,"AC",1,Z))
if Z=""
QUIT
IF IBTEXT[$$UP^XLFSTR(Z)
SET IBREV=1
QUIT
+10 ; Message contains text to make review unnecessary
IF 'IBREV
SET Z=""
FOR
SET Z=$ORDER(^IBE(361.3,"AC",0,Z))
if Z=""
QUIT
IF IBTEXT[$$UP^XLFSTR(Z)
SET Y=1
SET IBNR=Z
QUIT
+11 QUIT Y
+12 ;
REPORT ; Produce a report of messages filed without review by user-selected
+1 ; date range for date received and sort by either bill# or message text
+2 NEW IBFR,IBTO,IBSORT,DIR,DA,DR,X,Y,ZTSAVE,ZTRTN,ZTDESC,ZTREQ
R1 SET DIR("A")="FROM DATE RECEIVED: "
SET DIR(0)="DA^:"_DT_"::PAXE"
DO ^DIR
KILL DIR
+1 if $DATA(DTOUT)!$DATA(DUOUT)
QUIT
+2 SET IBFR=Y
WRITE " ",$GET(Y(0))
R2 SET DIR("A")="TO DATE RECEIVED: "
SET DIR(0)="DAO^"_IBFR_":"_DT_"::PAE"
DO ^DIR
KILL DIR
+1 if $DATA(DTOUT)!$DATA(DUOUT)
QUIT
+2 IF Y'>0
WRITE !
GOTO R1
+3 SET IBTO=Y
WRITE " ",$GET(Y(0))
+4 SET DIR("A")="SORT BY"
SET DIR(0)="SXBO^B:Bill #;M:Message Screen Text"
SET DIR("B")="B"
DO ^DIR
KILL DIR
+5 if $DATA(DTOUT)!$DATA(DUOUT)
QUIT
+6 IF (Y="")!("BM"'[Y)
WRITE !
GOTO R2
+7 SET IBSORT=Y
+8 SET %ZIS="QM"
DO ^%ZIS
if POP
QUIT
+9 IF $DATA(IO("Q"))
KILL IO("Q")
SET ZTRTN="ENRPT^IBCEM4"
SET ZTSAVE("IB*")=""
SET ZTDESC="IB - MESSAGES FILED WITHOUT REVIEW REPORT"
DO ^%ZTLOAD
KILL ZTSK
DO HOME^%ZIS
QUIT
+10 USE IO
ENRPT ; Queued job entrypoint
+1 NEW IB,IB0,IBDA,IB00,IB1,IBS1,IBPAGE,IBLINES,IBHDRDT,IBSB,IBSTOP,DIR,Y,X,Z
+2 ;Only initial form feed for print to screen
if $EXTRACT(IOST,1,2)["C-"
WRITE @IOF
+3 KILL ^TMP($JOB,"IBSORT")
+4 SET IB=IBFR-.000001
+5 FOR
SET IB=$ORDER(^IBM(361,"ARD",IB))
if 'IB!$GET(ZTSTOP)
QUIT
SET IBDA=0
FOR
SET IBDA=$ORDER(^IBM(361,"ARD",IB,IBDA))
if 'IBDA!$GET(ZTSTOP)
QUIT
SET IB0=$GET(^IBM(361,IBDA,0))
if IB0=""!'$PIECE(IB0,U,14)
QUIT
Begin DoDot:1
+6 IF $DATA(ZTQUEUED)
if $$STOP(.ZTREQ,.ZTSTOP)
QUIT
+7 SET IBS1=""
+8 ; Find text that caused auto-file
IF IBSORT="M"
Begin DoDot:2
+9 SET Z=0
FOR
SET Z=$ORDER(^IBM(361,IBDA,1,Z))
if 'Z
QUIT
IF $$CKREVU($GET(^IBM(361,IBDA,1,Z,0)),.IBS1,1)
QUIT
+10 IF IBS1=""
SET IBS1="??"
End DoDot:2
+11 IF IBSORT="B"
SET IBS1=$PIECE($GET(^DGCR(399,+IB0,0)),U)
+12 IF IBS1'=""
SET ^TMP($JOB,"IBSORT",IBS1,IBDA)=IB0
End DoDot:1
+13 SET IBHDRDT=$$FMTE^XLFDT($$NOW^XLFDT(),"2P")
+14 SET (IBSTOP,IBLINES,IBPAGE)=0
+15 SET IB1=1
SET IB=""
FOR
SET IB=$ORDER(^TMP($JOB,"IBSORT",IB))
if IB=""!$GET(ZTSTOP)
QUIT
Begin DoDot:1
+16 SET IBSB=$SELECT(IBSORT="M":"MESSAGE SCREEN TEXT: "_IB,1:"")
+17 IF IBSB'=""
SET IBSB=$JUSTIFY("",(80-$LENGTH(IBSB)\2))_IBSB
+18 if IB1
DO RHDR(IBSB,.IBSTOP)
if IBSTOP
QUIT
+19 IF 'IB1
IF IBSORT="M"
Begin DoDot:2
+20 IF IBLINES>(IOSL-5)
DO RHDR(IBSB,.IBSTOP)
QUIT
+21 WRITE !!,IBSB,!
SET IBLINES=IBLINES+3
End DoDot:2
if IBSTOP
QUIT
+22 SET (IB1,IBDA)=0
FOR
SET IBDA=$ORDER(^TMP($JOB,"IBSORT",IB,IBDA))
if 'IBDA!$GET(ZTSTOP)
QUIT
Begin DoDot:2
+23 IF $DATA(ZTQUEUED)
IF $$STOP(.ZTREQ,.ZTSTOP)
WRITE !,"*********** REPORT STOPPED BEFORE IT COMPLETED!!! ***********"
QUIT
+24 SET IB0=$GET(^TMP($JOB,"IBSORT",IB,IBDA))
SET IB00=$GET(^DGCR(399,+IB0,0))
+25 IF $GET(IBLINES)>(IOSL-5)
DO RHDR("",.IBSTOP)
if IBSTOP
QUIT
+26 WRITE !,$EXTRACT($$BN1^PRCAFN(+IB0)_$JUSTIFY("",10),1,10)," ",$EXTRACT($PIECE($GET(^DPT(+$PIECE(IB00,U,2),0)),U)_$JUSTIFY("",25),1,25)_" "_$EXTRACT($$FMTE^XLFDT(...
... $PIECE(IB00,U,3),"2D")_$JUSTIFY("",8),1,8)_" "_$EXTRACT($$FMTE^XLFDT($PIECE(IB0,U,2),"2D")_$JUSTIFY("",8),1,8)_" "
+27 WRITE $EXTRACT($PIECE($GET(^DIC(36,+$$POLICY^IBCEF(+IB0,1,$PIECE(IB0,U,7)),0)),U),1,20)
+28 SET IBLINES=IBLINES+1
+29 IF $GET(IBLINES)>(IOSL-5)
DO RHDR("",.IBSTOP)
if IBSTOP
QUIT
+30 SET Z=0
FOR
SET Z=$ORDER(^IBM(361,IBDA,1,Z))
if 'Z
QUIT
Begin DoDot:3
+31 NEW Z0,Z1
+32 SET Z0=$GET(^IBM(361,IBDA,1,Z,0))
+33 FOR Z1=1:75:$LENGTH(Z0)
if $GET(IBLINES)>(IOSL-5)
DO RHDR("",.IBSTOP)
if IBSTOP
QUIT
WRITE !,?5,$EXTRACT(Z0,Z1,Z1+74)
SET IBLINES=IBLINES+1
End DoDot:3
if IBSTOP
QUIT
End DoDot:2
if IBSTOP
QUIT
End DoDot:1
if IBSTOP
QUIT
+34 if IBSTOP!$GET(ZTSTOP)
GOTO ENSTOP
+35 IF $GET(IB1)
DO RHDR("")
WRITE !,"NO RECORDS MATCHING SEARCH CRITERIA WERE FOUND",!
+36 ;
+37 IF $EXTRACT(IOST,1,2)["C-"
KILL DIR
SET DIR(0)="E"
DO ^DIR
KILL DIR
ENSTOP IF '$DATA(ZTQUEUED)
DO ^%ZISC
+1 IF $DATA(ZTQUEUED)
IF '$GET(ZTSTOP)
SET ZTREQ="@"
+2 KILL ^TMP($JOB,"IBSORT")
+3 QUIT
+4 ;
RHDR(IBSB,IBSTOP) ; Report header
+1 ; IBSB'="" if sub header should print
+2 NEW Z,DIR,X,Y
+3 SET IBPAGE=IBPAGE+1
+4 IF IBPAGE>1
IF $EXTRACT(IOST,1,2)["C-"
SET DIR(0)="E"
DO ^DIR
KILL DIR
IF $DATA(DTOUT)!$DATA(DUOUT)
SET IBSTOP=1
GOTO RHDRQ
+5 WRITE !,@IOF
+6 WRITE !,?22,"MESSAGES FILED WITHOUT REVIEW REPORT",?65,"PAGE: ",IBPAGE
+7 SET Z="RUN DATE: "_IBHDRDT
WRITE !,?(80-$LENGTH(Z)\2),Z
+8 SET Z="DATE RECEIVED RANGE: "_$$FMTE^XLFDT(IBFR,"2D")_"-"_$$FMTE^XLFDT(IBTO,"2D")
WRITE !,?(80-$LENGTH(Z)\2),Z,!
+9 WRITE !,$JUSTIFY("",40),"EVENT DATE"
+10 WRITE !,"BILL # PATIENT NAME"_$JUSTIFY("",15)_" DATE RECEIVED INSURANCE CO",!
+11 SET Z=""
SET $PIECE(Z,"-",81)=""
WRITE Z
+12 SET IBLINES=7
+13 IF $GET(IBSB)'=""
WRITE !,IBSB,!
SET IBLINES=IBLINES+2
RHDRQ QUIT
+1 ;
STOP(IBSTOP,IBREQ) ; Check for job being stopped
+1 IF $$S^%ZTLOAD
SET IBSTOP=1
KILL IBREQ
+2 QUIT $GET(IBSTOP)
+3 ;
