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