Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: IBOCOSI

IBOCOSI.m

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