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