source: WorldVistAEHR/trunk/r/INTEGRATED_BILLING-IB-PRQ--IBD--IBQ--PRQS/IBOCOSI.m@ 1261

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)