- 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 Feb 18, 2025@23:53:47 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