IBTOECT ;OAK/ELZ- ENHANCED CLAIMS TRACKING REPORTS ;7/15/2005
;;2.0;INTEGRATED BILLING;**317**;21-MAR-94
;;Per VHA Directive 10-93-142, this routine should not be modified.
;
UNREV ; Main entry for the Un-reviewed Claims for Coders Report
;
N IBBEG,IBEND
;
D DATE^IBCONS4 Q:'$D(IBBEG)!('$D(IBEND))
Q:$$DEV("QUNREV","IB - Unreviewed Claims for Coders Report")
;
QUNREV ; tasman entry
U IO
N IBOE,IBX,IBCT0,IBCT2,IBPNAM,IBSSN,IBOE0,IBY,IBR,IBP,IBL,IBCPT,IBMOD,IBA,IBONE,IBC,DIR,X,Y,DTOUT,DUOUT,DIRUT,DIROUT
K ^TMP("IBTOECT",$J) S IBP=0,$P(IBL,"-",IOM)=""
;
; create sort by Outpatient Encounter then by patient name (no x-ref supports this)
S IBOE=$$FMADD^XLFDT($P(IBBEG,"."),-1)+.99 F S IBOE=$O(^IBT(356,"D",IBOE)) Q:'IBOE!(IBOE>(IBEND_".9999")) S IBX=0 F S IBX=$O(^IBT(356,"D",IBOE,IBX)) Q:'IBX D
. S IBCT0=$G(^IBT(356,IBX,0)),IBCT2=$G(^(2))
. I $P(IBCT0,"^",4),$P(IBCT0,"^",24),'$P(IBCT0,"^",19),'$P(IBCT2,"^",3),$P(IBCT0,"^",2) S ^TMP("IBTOECT",$J,IBOE,$P(^DPT($P(IBCT0,"^",2),0),"^"),IBX)=""
;
;
S IBOE=0 F S IBOE=$O(^TMP("IBTOECT",$J,IBOE)) Q:'IBOE!($D(DIRUT)) S IBPNAM="" F S IBPNAM=$O(^TMP("IBTOECT",$J,IBOE,IBPNAM)) Q:IBPNAM=""!($D(DIRUT)) S IBX=0 F S IBX=$O(^TMP("IBTOECT",$J,IBOE,IBPNAM,IBX)) Q:'IBX!($D(DIRUT)) D
. S IBCT0=$G(^IBT(356,IBX,0)) Q:'IBCT0
. S IBSSN=$P($G(^DPT(+$P(IBCT0,"^",2),0)),"^",9)
. S IBOE0=$G(^SCE(+$P(IBCT0,"^",4),0))
. S IBY=$$INSUR^IBBAPI($P(IBOE0,"^",2),+IBOE0,"RB",.IBR,"1,11,16")
. S IBCPT=0,IBONE=0
. ;
. I 'IBP!($Y+3>IOSL) D
. . I $E(IOST,1,2)="C-",IBP'=0 S DIR(0)="E" D ^DIR I $D(DIRUT) Q
. . S IBP=IBP+1
. . W @IOF,!,"Unreviewed Claims for Coders Report from ",$$FMTE^XLFDT(IBBEG)," to ",$$FMTE^XLFDT(IBEND),?100,$$FMTE^XLFDT(DT),?115,"Page: ",IBP
. . W !,"Patient Name",?27,"SSN",?39,"Visit Date",?58,"Location",?80,"CPTs",?87,"Mod",?91,"Insurance",?113,"Exp Date",?125,"Bill",!,IBL
. Q:$D(DIRUT)
. W:$X ! W $E(IBPNAM,1,25),?27,IBSSN,?39,$$FMTE^XLFDT(+IBOE0,2),?58,$E($P($G(^SC(+$P(IBOE0,"^",4),0)),"^"),1,20)
. S:$P(IBCT0,"^",3) IBCPT=$$GETIENS^PXAAVCPT($P(IBCT0,"^",3),.IBCPT)
. S (IBC,IBCPT)=0 F S IBCPT=$O(IBCPT(IBCPT)) Q:'IBCPT D
. . S IBC=IBC+1,IBONE=1
. . S IBA(IBC)=$$CPT^PXAAVCPT(IBCPT)
. . D:$P(IBCT0,"^",3) CPTMODIF^PXAAVCPT($P(IBCT0,"^",3),.IBMOD)
. . S IBMOD=0 F S IBMOD=$O(IBMOD(1,IBMOD)) Q:'IBMOD D
. . . S:'IBONE IBC=IBC+1
. . . S $P(IBA(IBC),"^",2)=$G(IBMOD(1,+IBMOD,0))
. . . S IBONE=0
. F IBC=1:1 Q:'$D(IBA(IBC))&('$D(IBR("IBBAPI","INSUR",IBC))) D
. . W:$G(IBA(IBC)) ?80,$P($$CPT^ICPTCOD(+$G(IBA(IBC)),+IBOE0),"^",2)
. . W:$P($G(IBA(IBC)),"^",2) ?87,$P($$MOD^ICPTMOD(+$P($G(IBA(IBC)),"^",2),"I",+IBOE0),"^",2)
. . W ?91,$E($P($G(IBR("IBBAPI","INSUR",IBC,1)),"^",2),1,20)
. . W:$G(IBR("IBBAPI","INSUR",IBC,11)) ?113,$$FMTE^XLFDT($G(IBR("IBBAPI","INSUR",IBC,11)),2)
. . W ?125,$P($G(IBR("IBBAPI","INSUR",IBC,16)),"^",2),!
. K IBA
;
;
K ^TMP("IBTOECT",$J)
D ^%ZISC
S:$D(ZTQUEUED) ZTREQ="@"
Q
;
ENR ; entered/not reviewed report
;
N IBBEG,IBEND
;
D DATE^IBCONS4 Q:'$D(IBBEG)!('$D(IBEND))
Q:$$DEV("QENR","IB - Entered/Not Reviewed Bills Report")
;
QENR ; tasked entry
;
N IBDT,IB0,IBR,IBPNAM,IBX,DFN,IBP,IBL,IBPNAMS,IBCP,IBC,DIR,X,Y,DTOUT,DUOUT,DIRUT,DIROUT,IBA
U IO
K ^TMP("IBTOECT",$J)
;
;set up some variables
S IBR=$S($O(^DGCR(399.3,"B","REIMBURSABLE INS.",0)):$O(^DGCR(399.3,"B","REIMBURSABLE INS.",0)),1:8)
S IBP=0,$P(IBL,"-",IOM)="",IBPNAMS=""
;
; find the bills that match criteria and sort in ^tmp
S IBDT=$$FMADD^XLFDT($P(IBBEG,"."),-1)+.99 F S IBDT=$O(^DGCR(399,"D",IBDT)) Q:'IBDT!(IBDT>(IBEND_".9999")) S IBX=0 F S IBX=$O(^DGCR(399,"D",IBDT,IBX)) Q:'IBX S IB0=^DGCR(399,IBX,0) D
. I $P(IB0,"^",7)=IBR,$P(IB0,"^",5)=3,$P(IB0,"^",13)=1 S ^TMP("IBTOECT",$J,$P(^DPT($P(IB0,"^",2),0),"^"),IBDT,IBX)=""
;
S IBPNAM="" F S IBPNAM=$O(^TMP("IBTOECT",$J,IBPNAM)) Q:IBPNAM=""!($D(DIRUT)) S IBDT=0 F S IBDT=$O(^TMP("IBTOECT",$J,IBPNAM,IBDT)) Q:'IBDT!($D(DIRUT)) S IBX=0 F S IBX=$O(^TMP("IBTOECT",$J,IBPNAM,IBDT,IBX)) Q:'IBX!($D(DIRUT)) D
. S IB0=$G(^DGCR(399,IBX,0)),DFN=$P(IB0,"^",2) Q:'DFN
. D DEM^VADPT,ELIG^VADPT
. I 'IBP!($Y+5>IOSL) D
. . I $E(IOST,1,2)="C-",IBP'=0 S DIR(0)="E" D ^DIR I $D(DIRUT) Q
. . S IBP=IBP+1
. . W @IOF,!,"Entered/Not Reviewed Bills Report from ",$$FMTE^XLFDT(IBBEG)," to ",$$FMTE^XLFDT(IBEND),?100,$$FMTE^XLFDT(DT),?115,"Page: ",IBP
. . W !,"Bill #",?12,"Primary Insurance",?34,"Clinic",?44,"Date",?56,"Proc",?63,"Provider",?85,"RNB",?107,"Billable Findings",!,IBL
. Q:$D(DIRUT)
. W:IBPNAMS'=IBPNAM !,"Name: ",$E(VADM(1),1,25),?33,"Sex: ",$P(VADM(5),"^"),?42,"SSN: ",$P(VADM(2),"^",2),?61,"Age: ",VADM(4),?70,"MT Status: ",$P(VAEL(9),"^",2)
. S IBPNAMS=IBPNAM
. W:$X ! W $P(IB0,"^"),?12,$E($P($G(^DIC(36,+^DGCR(399,IBX,"M"),0)),"^"),1,20)
. ; IBA format: 399 sub CP ien ^ RNB (ien) (only one) ^ billable findings description (ien)
. S (IBCP,IBC)=0 F S IBCP=$O(^DGCR(399,IBX,"CP",IBCP)) Q:'IBCP S IBC=IBC+1,IBA(IBC)=IBCP
. S IBCT=$O(^IBT(356,"E",IBX,0)),$P(IBA(1),"^",2)=$P($G(^IBT(356,+IBCT,0)),"^",19)
. S (IBCP,IBC)=0 F S IBCP=$O(^IBT(356,+IBCT,3,IBCP)) Q:'IBCP S IBC=IBC+1,$P(IBA(IBC),"^",3)=$G(^IBT(356,IBCT,3,IBCP,0))
. F IBC=1:1 Q:'$D(IBA(IBC)) D
. . S IBCP=$G(^DGCR(399,IBX,"CP",+IBA(IBC),0))
. . W ?34,$E($P($G(^SC(+$P(IBCP,"^",7),0)),"^"),1,7)
. . W ?44,$$FMTE^XLFDT($P(IBCP,"^",2),2)
. . W ?56,$$EXTERNAL^DILFD(399.0304,.01,,$P(IBCP,"^"))
. . W ?63,$E($P($G(^VA(200,+$P(IBCP,"^",18),0)),"^"),1,20)
. . W ?85,$E($P($G(^IBE(356.8,+$P(IBA(IBC),"^",2),0)),"^"),1,20)
. . W ?107,$E($P($G(^IBT(356.85,+$P(IBA(IBC),"^",3),0)),"^"),1,20),!
. K IBA
;
K ^TMP("IBTOECT",$J)
D ^%ZISC
S:$D(ZTQUEUED) ZTREQ="@"
;
Q
;
DEV(ZTRTN,ZTDESC) ; -- ask device
N ZTSAVE,IBRTN,%ZIS,POP,ZTSK
;
W !!,"*** Margin width of this output is 132 ***"
W !,"*** This output should be queued ***"
;
S %ZIS="QM" D ^%ZIS I POP Q 1
I $D(IO("Q")) D Q 1
.S ZTRTN=ZTRTN_"^IBTOECT",ZTSAVE("IB*")=""
.D ^%ZTLOAD,HOME^%ZIS W "Task #",ZTSK K IO("Q")
Q 0
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBTOECT 6077 printed Dec 13, 2024@02:27:17 Page 2
IBTOECT ;OAK/ELZ- ENHANCED CLAIMS TRACKING REPORTS ;7/15/2005
+1 ;;2.0;INTEGRATED BILLING;**317**;21-MAR-94
+2 ;;Per VHA Directive 10-93-142, this routine should not be modified.
+3 ;
UNREV ; Main entry for the Un-reviewed Claims for Coders Report
+1 ;
+2 NEW IBBEG,IBEND
+3 ;
+4 DO DATE^IBCONS4
if '$DATA(IBBEG)!('$DATA(IBEND))
QUIT
+5 if $$DEV("QUNREV","IB - Unreviewed Claims for Coders Report")
QUIT
+6 ;
QUNREV ; tasman entry
+1 USE IO
+2 NEW IBOE,IBX,IBCT0,IBCT2,IBPNAM,IBSSN,IBOE0,IBY,IBR,IBP,IBL,IBCPT,IBMOD,IBA,IBONE,IBC,DIR,X,Y,DTOUT,DUOUT,DIRUT,DIROUT
+3 KILL ^TMP("IBTOECT",$JOB)
SET IBP=0
SET $PIECE(IBL,"-",IOM)=""
+4 ;
+5 ; create sort by Outpatient Encounter then by patient name (no x-ref supports this)
+6 SET IBOE=$$FMADD^XLFDT($PIECE(IBBEG,"."),-1)+.99
FOR
SET IBOE=$ORDER(^IBT(356,"D",IBOE))
if 'IBOE!(IBOE>(IBEND_".9999"))
QUIT
SET IBX=0
FOR
SET IBX=$ORDER(^IBT(356,"D",IBOE,IBX))
if 'IBX
QUIT
Begin DoDot:1
+7 SET IBCT0=$GET(^IBT(356,IBX,0))
SET IBCT2=$GET(^(2))
+8 IF $PIECE(IBCT0,"^",4)
IF $PIECE(IBCT0,"^",24)
IF '$PIECE(IBCT0,"^",19)
IF '$PIECE(IBCT2,"^",3)
IF $PIECE(IBCT0,"^",2)
SET ^TMP("IBTOECT",$JOB,IBOE,$PIECE(^DPT($PIECE(IBCT0,"^",2),0),"^"),IBX)=""
End DoDot:1
+9 ;
+10 ;
+11 SET IBOE=0
FOR
SET IBOE=$ORDER(^TMP("IBTOECT",$JOB,IBOE))
if 'IBOE!($DATA(DIRUT))
QUIT
SET IBPNAM=""
FOR
SET IBPNAM=$ORDER(^TMP("IBTOECT",$JOB,IBOE,IBPNAM))
if IBPNAM=""!($DATA(DIRUT))
QUIT
SET IBX=0
FOR
SET IBX=$ORDER(^TMP("IBTOECT",$JOB,IBOE,IBPNAM,IBX))
if 'IBX!($DATA(DIRUT))
QUIT
Begin DoDot:1
+12 SET IBCT0=$GET(^IBT(356,IBX,0))
if 'IBCT0
QUIT
+13 SET IBSSN=$PIECE($GET(^DPT(+$PIECE(IBCT0,"^",2),0)),"^",9)
+14 SET IBOE0=$GET(^SCE(+$PIECE(IBCT0,"^",4),0))
+15 SET IBY=$$INSUR^IBBAPI($PIECE(IBOE0,"^",2),+IBOE0,"RB",.IBR,"1,11,16")
+16 SET IBCPT=0
SET IBONE=0
+17 ;
+18 IF 'IBP!($Y+3>IOSL)
Begin DoDot:2
+19 IF $EXTRACT(IOST,1,2)="C-"
IF IBP'=0
SET DIR(0)="E"
DO ^DIR
IF $DATA(DIRUT)
QUIT
+20 SET IBP=IBP+1
+21 WRITE @IOF,!,"Unreviewed Claims for Coders Report from ",$$FMTE^XLFDT(IBBEG)," to ",$$FMTE^XLFDT(IBEND),?100,$$FMTE^XLFDT(DT),?115,"Page: ",IBP
+22 WRITE !,"Patient Name",?27,"SSN",?39,"Visit Date",?58,"Location",?80,"CPTs",?87,"Mod",?91,"Insurance",?113,"Exp Date",?125,"Bill",!,IBL
End DoDot:2
+23 if $DATA(DIRUT)
QUIT
+24 if $X
WRITE !
WRITE $EXTRACT(IBPNAM,1,25),?27,IBSSN,?39,$$FMTE^XLFDT(+IBOE0,2),?58,$EXTRACT($PIECE($GET(^SC(+$PIECE(IBOE0,"^",4),0)),"^"),1,20)
+25 if $PIECE(IBCT0,"^",3)
SET IBCPT=$$GETIENS^PXAAVCPT($PIECE(IBCT0,"^",3),.IBCPT)
+26 SET (IBC,IBCPT)=0
FOR
SET IBCPT=$ORDER(IBCPT(IBCPT))
if 'IBCPT
QUIT
Begin DoDot:2
+27 SET IBC=IBC+1
SET IBONE=1
+28 SET IBA(IBC)=$$CPT^PXAAVCPT(IBCPT)
+29 if $PIECE(IBCT0,"^",3)
DO CPTMODIF^PXAAVCPT($PIECE(IBCT0,"^",3),.IBMOD)
+30 SET IBMOD=0
FOR
SET IBMOD=$ORDER(IBMOD(1,IBMOD))
if 'IBMOD
QUIT
Begin DoDot:3
+31 if 'IBONE
SET IBC=IBC+1
+32 SET $PIECE(IBA(IBC),"^",2)=$GET(IBMOD(1,+IBMOD,0))
+33 SET IBONE=0
End DoDot:3
End DoDot:2
+34 FOR IBC=1:1
if '$DATA(IBA(IBC))&('$DATA(IBR("IBBAPI","INSUR",IBC)))
QUIT
Begin DoDot:2
+35 if $GET(IBA(IBC))
WRITE ?80,$PIECE($$CPT^ICPTCOD(+$GET(IBA(IBC)),+IBOE0),"^",2)
+36 if $PIECE($GET(IBA(IBC)),"^",2)
WRITE ?87,$PIECE($$MOD^ICPTMOD(+$PIECE($GET(IBA(IBC)),"^",2),"I",+IBOE0),"^",2)
+37 WRITE ?91,$EXTRACT($PIECE($GET(IBR("IBBAPI","INSUR",IBC,1)),"^",2),1,20)
+38 if $GET(IBR("IBBAPI","INSUR",IBC,11))
WRITE ?113,$$FMTE^XLFDT($GET(IBR("IBBAPI","INSUR",IBC,11)),2)
+39 WRITE ?125,$PIECE($GET(IBR("IBBAPI","INSUR",IBC,16)),"^",2),!
End DoDot:2
+40 KILL IBA
End DoDot:1
+41 ;
+42 ;
+43 KILL ^TMP("IBTOECT",$JOB)
+44 DO ^%ZISC
+45 if $DATA(ZTQUEUED)
SET ZTREQ="@"
+46 QUIT
+47 ;
ENR ; entered/not reviewed report
+1 ;
+2 NEW IBBEG,IBEND
+3 ;
+4 DO DATE^IBCONS4
if '$DATA(IBBEG)!('$DATA(IBEND))
QUIT
+5 if $$DEV("QENR","IB - Entered/Not Reviewed Bills Report")
QUIT
+6 ;
QENR ; tasked entry
+1 ;
+2 NEW IBDT,IB0,IBR,IBPNAM,IBX,DFN,IBP,IBL,IBPNAMS,IBCP,IBC,DIR,X,Y,DTOUT,DUOUT,DIRUT,DIROUT,IBA
+3 USE IO
+4 KILL ^TMP("IBTOECT",$JOB)
+5 ;
+6 ;set up some variables
+7 SET IBR=$SELECT($ORDER(^DGCR(399.3,"B","REIMBURSABLE INS.",0)):$ORDER(^DGCR(399.3,"B","REIMBURSABLE INS.",0)),1:8)
+8 SET IBP=0
SET $PIECE(IBL,"-",IOM)=""
SET IBPNAMS=""
+9 ;
+10 ; find the bills that match criteria and sort in ^tmp
+11 SET IBDT=$$FMADD^XLFDT($PIECE(IBBEG,"."),-1)+.99
FOR
SET IBDT=$ORDER(^DGCR(399,"D",IBDT))
if 'IBDT!(IBDT>(IBEND_".9999"))
QUIT
SET IBX=0
FOR
SET IBX=$ORDER(^DGCR(399,"D",IBDT,IBX))
if 'IBX
QUIT
SET IB0=^DGCR(399,IBX,0)
Begin DoDot:1
+12 IF $PIECE(IB0,"^",7)=IBR
IF $PIECE(IB0,"^",5)=3
IF $PIECE(IB0,"^",13)=1
SET ^TMP("IBTOECT",$JOB,$PIECE(^DPT($PIECE(IB0,"^",2),0),"^"),IBDT,IBX)=""
End DoDot:1
+13 ;
+14 SET IBPNAM=""
FOR
SET IBPNAM=$ORDER(^TMP("IBTOECT",$JOB,IBPNAM))
if IBPNAM=""!($DATA(DIRUT))
QUIT
SET IBDT=0
FOR
SET IBDT=$ORDER(^TMP("IBTOECT",$JOB,IBPNAM,IBDT))
if 'IBDT!($DATA(DIRUT))
QUIT
SET IBX=0
FOR
SET IBX=$ORDER(^TMP("IBTOECT",$JOB,IBPNAM,IBDT,IBX))
if 'IBX!($DATA(DIRUT))
QUIT
Begin DoDot:1
+15 SET IB0=$GET(^DGCR(399,IBX,0))
SET DFN=$PIECE(IB0,"^",2)
if 'DFN
QUIT
+16 DO DEM^VADPT
DO ELIG^VADPT
+17 IF 'IBP!($Y+5>IOSL)
Begin DoDot:2
+18 IF $EXTRACT(IOST,1,2)="C-"
IF IBP'=0
SET DIR(0)="E"
DO ^DIR
IF $DATA(DIRUT)
QUIT
+19 SET IBP=IBP+1
+20 WRITE @IOF,!,"Entered/Not Reviewed Bills Report from ",$$FMTE^XLFDT(IBBEG)," to ",$$FMTE^XLFDT(IBEND),?100,$$FMTE^XLFDT(DT),?115,"Page: ",IBP
+21 WRITE !,"Bill #",?12,"Primary Insurance",?34,"Clinic",?44,"Date",?56,"Proc",?63,"Provider",?85,"RNB",?107,"Billable Findings",!,IBL
End DoDot:2
+22 if $DATA(DIRUT)
QUIT
+23 if IBPNAMS'=IBPNAM
WRITE !,"Name: ",$EXTRACT(VADM(1),1,25),?33,"Sex: ",$PIECE(VADM(5),"^"),?42,"SSN: ",$PIECE(VADM(2),"^",2),?61,"Age: ",VADM(4),?70,"MT Status: ",$PIECE(VAEL(9),"^",2)
+24 SET IBPNAMS=IBPNAM
+25 if $X
WRITE !
WRITE $PIECE(IB0,"^"),?12,$EXTRACT($PIECE($GET(^DIC(36,+^DGCR(399,IBX,"M"),0)),"^"),1,20)
+26 ; IBA format: 399 sub CP ien ^ RNB (ien) (only one) ^ billable findings description (ien)
+27 SET (IBCP,IBC)=0
FOR
SET IBCP=$ORDER(^DGCR(399,IBX,"CP",IBCP))
if 'IBCP
QUIT
SET IBC=IBC+1
SET IBA(IBC)=IBCP
+28 SET IBCT=$ORDER(^IBT(356,"E",IBX,0))
SET $PIECE(IBA(1),"^",2)=$PIECE($GET(^IBT(356,+IBCT,0)),"^",19)
+29 SET (IBCP,IBC)=0
FOR
SET IBCP=$ORDER(^IBT(356,+IBCT,3,IBCP))
if 'IBCP
QUIT
SET IBC=IBC+1
SET $PIECE(IBA(IBC),"^",3)=$GET(^IBT(356,IBCT,3,IBCP,0))
+30 FOR IBC=1:1
if '$DATA(IBA(IBC))
QUIT
Begin DoDot:2
+31 SET IBCP=$GET(^DGCR(399,IBX,"CP",+IBA(IBC),0))
+32 WRITE ?34,$EXTRACT($PIECE($GET(^SC(+$PIECE(IBCP,"^",7),0)),"^"),1,7)
+33 WRITE ?44,$$FMTE^XLFDT($PIECE(IBCP,"^",2),2)
+34 WRITE ?56,$$EXTERNAL^DILFD(399.0304,.01,,$PIECE(IBCP,"^"))
+35 WRITE ?63,$EXTRACT($PIECE($GET(^VA(200,+$PIECE(IBCP,"^",18),0)),"^"),1,20)
+36 WRITE ?85,$EXTRACT($PIECE($GET(^IBE(356.8,+$PIECE(IBA(IBC),"^",2),0)),"^"),1,20)
+37 WRITE ?107,$EXTRACT($PIECE($GET(^IBT(356.85,+$PIECE(IBA(IBC),"^",3),0)),"^"),1,20),!
End DoDot:2
+38 KILL IBA
End DoDot:1
+39 ;
+40 KILL ^TMP("IBTOECT",$JOB)
+41 DO ^%ZISC
+42 if $DATA(ZTQUEUED)
SET ZTREQ="@"
+43 ;
+44 QUIT
+45 ;
DEV(ZTRTN,ZTDESC) ; -- ask device
+1 NEW ZTSAVE,IBRTN,%ZIS,POP,ZTSK
+2 ;
+3 WRITE !!,"*** Margin width of this output is 132 ***"
+4 WRITE !,"*** This output should be queued ***"
+5 ;
+6 SET %ZIS="QM"
DO ^%ZIS
IF POP
QUIT 1
+7 IF $DATA(IO("Q"))
Begin DoDot:1
+8 SET ZTRTN=ZTRTN_"^IBTOECT"
SET ZTSAVE("IB*")=""
+9 DO ^%ZTLOAD
DO HOME^%ZIS
WRITE "Task #",ZTSK
KILL IO("Q")
End DoDot:1
QUIT 1
+10 QUIT 0
