IBOCOSI ;ALB/ARH - LIST INACTIVE CODES FROM COS; 5/27/92 ;;2.0;INTEGRATED BILLING;**133**;21-MAR-94 ; EN ;get device then run the report ; **** ;S XRTL=$ZU(0),XRTN="IBOCOSI-1" D T0^%ZOSV ;start rt clock S IBHDR="INACTIVE CPT CODES ON CHECK-OFF SHEETS" S %ZIS="QM",%ZIS("A")="OUTPUT DEVICE: " D ^%ZIS G:POP EXIT I $D(IO("Q")) S ZTRTN="EN1^IBOCOSI",ZTDESC=IBHDR D ^%ZTLOAD K IO("Q") G EXIT U IO ;*** ;I $D(XRT0) S:'$D(XRTN) XRTN="IBOCOSI" D T1^%ZOSV ;stop rt clock D EN1 D ^%ZISC ; EXIT ;clean up and quit ;*** ;I $D(XRT0) S:'$D(XRTN) XRTN="IBOCOSI" D T1^%ZOSV ;stop rt clock Q:$D(ZTQUEUED) K IBHDR,X,Y,DTOUT,DUOUT,DIRUT,DIROUT Q ; EN1 ;entry pt. for tasked jobs ;*** ;S XRTL=$ZU(0),XRTN="IBOCOSI-2" D T0^%ZOSV ;start rt clock S IBCPT="",IBQ=0 F S IBCPT=$O(^IBE(350.71,"P",IBCPT)) Q:IBCPT=""!IBQ D S IBQ=$$STOP . S IBX="" F S IBX=$O(^IBE(350.71,"P",IBCPT,IBX)) Q:IBX="" D .. S IBLN=$G(^IBE(350.71,IBX,0)),IBSTAT=+$$CPTSTAT^IBEFUNC2(+$P(IBLN,"^",6)) .. Q:IBSTAT>1 S (IBCPTP,IBSUBH,IBCHECK)="" .. S IBSUBH=$G(^IBE(350.71,+$P(IBLN,"^",5),0)) .. I IBSUBH'="" S IBCHECK=$P($G(^IBE(350.7,+$P(IBSUBH,"^",4),0)),"^",1) .. S IBSUBH=$P(IBSUBH,"^",1),IBCPTP=$P($$CPT^ICPTCOD(IBCPT),"^",2) .. S ^TMP("IBINACT",$J,IBSTAT,IBCPTP,IBCHECK,IBSUBH)=$P($$CPT^ICPTCOD(IBCPT),"^",3) K IBCPT,IBX,IBLN,IBSTAT,IBCPTP,IBSUBH,IBCHECK G:IBQ END ; PRINT ;set up headers and dates then print S IBHDR="INACTIVE CPT CODES ON CHECK-OFF SHEETS" D NOW^%DTC S Y=$E(%,1,12) D DD^%DT S IBCDT=$P(Y,"@",1)_" "_$P(Y,"@",2) S (IBPGN,IBLN)=0,IB3=(IOM-80)/3,IB1=IB3+20,(IB2,IB3)=IB3+24,IBDSH="" F IBI=1:1:IOM S IBDSH=IBDSH_"-" D HDR,P1 END K IBHDR,IBCDT,IBPGN,IBQ,IBLN,IBI,IB1,IB2,IB3,IBDSH,Y,X,^TMP("IBINACT",$J) ;*** ;I $D(XRT0) S:'$D(XRTN) XRTN="IBOCOSI" D T1^%ZOSV ;stop rt clock Q ; P1 ;print the report from the temp sort file to the appropriate device S IBSTAT="" F S IBSTAT=$O(^TMP("IBINACT",$J,IBSTAT)) Q:IBSTAT=""!(IBQ) S IBCPT="" D . W !!,?15,$S(IBSTAT=0:"AMA INACTIVE",1:"NATIONALLY, LOCALLY AND BILLING INACTIVE"),! S IBLN=IBLN+3 . F S IBCPT=$O(^TMP("IBINACT",$J,IBSTAT,IBCPT)) Q:IBCPT=""!(IBQ) S IBCHECK="",IBI=1 D .. F S IBCHECK=$O(^TMP("IBINACT",$J,IBSTAT,IBCPT,IBCHECK)) Q:IBCHECK=""!(IBQ) S IBSUBH="" D ... F S IBSUBH=$O(^TMP("IBINACT",$J,IBSTAT,IBCPT,IBCHECK,IBSUBH)) Q:IBSUBH=""!(IBQ) D .... I IBI S IBCPTP=^(IBSUBH) W !,IBCPT,?7,$E(IBCPTP,1,IB1) .... W:'IBI ! W ?(9+IB1),$E(IBCHECK,1,IB2),?(11+IB1+IB2),$E(IBSUBH,1,IB3) S IBLN=IBLN+1,IBI=0 D:IBLN>IOSL HDR D:'IBQ PAUSE K IBSTAT,IBCPT,IBCHECK,IBSUBH,IBCPTP,IBI,X,Y Q ; HDR ;print the report header S IBQ=$$STOP Q:IBQ D:IBPGN>0 PAUSE Q:IBQ S IBPGN=IBPGN+1,IBLN=6 I IBPGN>1!($E(IOST,1,2)["C-") W @IOF W IBHDR,?(IOM-30),IBCDT,?(IOM-8),"PAGE ",IBPGN,! W !,"PROCEDURE",?(9+IB1),"CHECK-OFF SHEET",?(11+IB1+IB2),"SUBHEADER",! W IBDSH Q ; PAUSE ;pause at end of screen if being displayed on a terminal Q:$E(IOST,1,2)'["C-" S DIR(0)="E" D ^DIR I $D(DUOUT)!($D(DIRUT)) S IBQ=1 K DIR,DIROUT,DTOUT,DUOUT,DIRUT Q ; STOP() ;determine if user requested task to stop I $D(ZTQUEUED),$$S^%ZTLOAD S ZTSTOP=1 K ZTREQ I +$G(IBPGN) W !!,"***TASK STOPPED BY USER***",!! Q +$G(ZTSTOP)