- 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 Feb 18, 2025@23:38:44 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 ;