IBCERP6A ;ALB/JEH - READY FOR EXTRACT LIST MANAGER REPORT ;27-OCT-99
;;2.0;INTEGRATED BILLING;**137**;21-MAR-94
;;Per VHA Directive 10-93-142, this routine should not be modified.
;
EN ; - Ask device
N %ZIS,ZTRTN,ZTSAVE,ZTDESC
S %ZIS="QM" D ^%ZIS G:POP ENQ1
I $D(IO("Q")) D G ENQ1
.S ZTRTN="LIST^IBCERP6A",ZTDESC="IB - EDI/MRA Claims in Rescue Process"
.S ZTSAVE("IBPARAM")="",ZTSAVE("^TMP(""IBCERP6"",$J,")=""
.D ^%ZTLOAD
.W !!,$S($D(ZTSK):"Your task number"_ZTSK_" has been queued.",1:"Unable to queue this job.")
.K ZTSK,IO("Q") D HOME^%ZIS
U IO
;
LIST ; - Tasked entry point
;
;
S (IBQUIT,IBPG)=0 D HDR
I '$D(^TMP("IBCERP6",$J)) W !!,"There are no records to print" G ENQ1
S IBSTAT="" F S IBSTAT=$O(^TMP("IBCERP6",$J,IBSTAT)) Q:IBSTAT=""!(IBQUIT) D
.S IBILL="" F S IBILL=$O(^TMP("IBCERP6",$J,IBSTAT,IBILL)) Q:IBILL=""!(IBQUIT) S IBREC=^(IBILL) D
..I ($Y+5)>IOSL D I IBQUIT Q
...D ASK I IBQUIT Q
...D HDR
..;
..W !,?2,$P(IBREC,U,2),?15,$P(IBREC,U,3),?22,$P(IBREC,U,4)
..W ?28,$E($P(IBREC,U,5),1,4),?35,$P(IBREC,U,6),?40,$E($P(IBREC,U,7),6,7)_"/"_$E($P(IBREC,U,7),4,5)_"/"_$E($P(IBREC,U,7),2,3)
..W ?50,$P(IBREC,U,8),?55,$E($P(IBREC,U,9),1,13),?70,$E($P(IBREC,U,10),1,9)
I $D(ZTQUEUED) S ZTREQ="@"
;
I '$D(ZTQUEUED) D ^%ZISC
ENQ1 K IBSTAT,IBILL,IBREC,IBPG,IBQUIT
Q
HDR ;Prints report heading
I $E(IOST,1,2)="C-" W @IOF,*13
S IBPG=IBPG+1
W !!,?25,"Claims in Rescue Process",?55,$$FMTE^XLFDT(DT),?70,"Page: ",IBPG
W !!,?15,"Inpt/",?22,"Inst/",!,?4,"Bill #",?15,"Opt",?22,"Prof",?28,"Name"
W ?35,"SSN",?40,"Stmt Date",?50,"Type",?55,"Ins Co.",?70,"Status"
W !,$TR($J("",IOM)," ","=")
Q
;
ASK ;
I $E(IOST,1,2)'["C-" Q
N DIR,DIROUT,DIRUT,DTOUT,DUOUT
S DIR(0)="E" D ^DIR
I ($D(DIRUT))!($D(DUOUT)) S IBQUIT=1 Q
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBCERP6A 1811 printed Sep 23, 2025@19:48:34 Page 2
IBCERP6A ;ALB/JEH - READY FOR EXTRACT LIST MANAGER REPORT ;27-OCT-99
+1 ;;2.0;INTEGRATED BILLING;**137**;21-MAR-94
+2 ;;Per VHA Directive 10-93-142, this routine should not be modified.
+3 ;
EN ; - Ask device
+1 NEW %ZIS,ZTRTN,ZTSAVE,ZTDESC
+2 SET %ZIS="QM"
DO ^%ZIS
if POP
GOTO ENQ1
+3 IF $DATA(IO("Q"))
Begin DoDot:1
+4 SET ZTRTN="LIST^IBCERP6A"
SET ZTDESC="IB - EDI/MRA Claims in Rescue Process"
+5 SET ZTSAVE("IBPARAM")=""
SET ZTSAVE("^TMP(""IBCERP6"",$J,")=""
+6 DO ^%ZTLOAD
+7 WRITE !!,$SELECT($DATA(ZTSK):"Your task number"_ZTSK_" has been queued.",1:"Unable to queue this job.")
+8 KILL ZTSK,IO("Q")
DO HOME^%ZIS
End DoDot:1
GOTO ENQ1
+9 USE IO
+10 ;
LIST ; - Tasked entry point
+1 ;
+2 ;
+3 SET (IBQUIT,IBPG)=0
DO HDR
+4 IF '$DATA(^TMP("IBCERP6",$JOB))
WRITE !!,"There are no records to print"
GOTO ENQ1
+5 SET IBSTAT=""
FOR
SET IBSTAT=$ORDER(^TMP("IBCERP6",$JOB,IBSTAT))
if IBSTAT=""!(IBQUIT)
QUIT
Begin DoDot:1
+6 SET IBILL=""
FOR
SET IBILL=$ORDER(^TMP("IBCERP6",$JOB,IBSTAT,IBILL))
if IBILL=""!(IBQUIT)
QUIT
SET IBREC=^(IBILL)
Begin DoDot:2
+7 IF ($Y+5)>IOSL
Begin DoDot:3
+8 DO ASK
IF IBQUIT
QUIT
+9 DO HDR
End DoDot:3
IF IBQUIT
QUIT
+10 ;
+11 WRITE !,?2,$PIECE(IBREC,U,2),?15,$PIECE(IBREC,U,3),?22,$PIECE(IBREC,U,4)
+12 WRITE ?28,$EXTRACT($PIECE(IBREC,U,5),1,4),?35,$PIECE(IBREC,U,6),?40,$EXTRACT($PIECE(IBREC,U,7),6,7)_"/"_$EXTRACT($PIECE(IBREC,U,7),4,5)_"/"_$EXTRACT($PIECE(IBREC,U,7),2,3)
+13 WRITE ?50,$PIECE(IBREC,U,8),?55,$EXTRACT($PIECE(IBREC,U,9),1,13),?70,$EXTRACT($PIECE(IBREC,U,10),1,9)
End DoDot:2
End DoDot:1
+14 IF $DATA(ZTQUEUED)
SET ZTREQ="@"
+15 ;
+16 IF '$DATA(ZTQUEUED)
DO ^%ZISC
ENQ1 KILL IBSTAT,IBILL,IBREC,IBPG,IBQUIT
+1 QUIT
HDR ;Prints report heading
+1 IF $EXTRACT(IOST,1,2)="C-"
WRITE @IOF,*13
+2 SET IBPG=IBPG+1
+3 WRITE !!,?25,"Claims in Rescue Process",?55,$$FMTE^XLFDT(DT),?70,"Page: ",IBPG
+4 WRITE !!,?15,"Inpt/",?22,"Inst/",!,?4,"Bill #",?15,"Opt",?22,"Prof",?28,"Name"
+5 WRITE ?35,"SSN",?40,"Stmt Date",?50,"Type",?55,"Ins Co.",?70,"Status"
+6 WRITE !,$TRANSLATE($JUSTIFY("",IOM)," ","=")
+7 QUIT
+8 ;
ASK ;
+1 IF $EXTRACT(IOST,1,2)'["C-"
QUIT
+2 NEW DIR,DIROUT,DIRUT,DTOUT,DUOUT
+3 SET DIR(0)="E"
DO ^DIR
+4 IF ($DATA(DIRUT))!($DATA(DUOUT))
SET IBQUIT=1
QUIT
+5 QUIT
+6 ;
