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

Last change on this file since 1274 was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version
File size: 3.1 KB
Line 
1IBOCOSI ;ALB/ARH - LIST INACTIVE CODES FROM COS; 5/27/92
2 ;;2.0;INTEGRATED BILLING;**133**;21-MAR-94
3 ;
4EN ;get device then run the report
5 ; ****
6 ;S XRTL=$ZU(0),XRTN="IBOCOSI-1" D T0^%ZOSV ;start rt clock
7 S IBHDR="INACTIVE CPT CODES ON CHECK-OFF SHEETS"
8 S %ZIS="QM",%ZIS("A")="OUTPUT DEVICE: " D ^%ZIS G:POP EXIT
9 I $D(IO("Q")) S ZTRTN="EN1^IBOCOSI",ZTDESC=IBHDR D ^%ZTLOAD K IO("Q") G EXIT
10 U IO
11 ;***
12 ;I $D(XRT0) S:'$D(XRTN) XRTN="IBOCOSI" D T1^%ZOSV ;stop rt clock
13 D EN1 D ^%ZISC
14 ;
15EXIT ;clean up and quit
16 ;***
17 ;I $D(XRT0) S:'$D(XRTN) XRTN="IBOCOSI" D T1^%ZOSV ;stop rt clock
18 Q:$D(ZTQUEUED) K IBHDR,X,Y,DTOUT,DUOUT,DIRUT,DIROUT
19 Q
20 ;
21EN1 ;entry pt. for tasked jobs
22 ;***
23 ;S XRTL=$ZU(0),XRTN="IBOCOSI-2" D T0^%ZOSV ;start rt clock
24 S IBCPT="",IBQ=0 F S IBCPT=$O(^IBE(350.71,"P",IBCPT)) Q:IBCPT=""!IBQ D S IBQ=$$STOP
25 . S IBX="" F S IBX=$O(^IBE(350.71,"P",IBCPT,IBX)) Q:IBX="" D
26 .. S IBLN=$G(^IBE(350.71,IBX,0)),IBSTAT=+$$CPTSTAT^IBEFUNC2(+$P(IBLN,"^",6))
27 .. Q:IBSTAT>1 S (IBCPTP,IBSUBH,IBCHECK)=""
28 .. S IBSUBH=$G(^IBE(350.71,+$P(IBLN,"^",5),0))
29 .. I IBSUBH'="" S IBCHECK=$P($G(^IBE(350.7,+$P(IBSUBH,"^",4),0)),"^",1)
30 .. S IBSUBH=$P(IBSUBH,"^",1),IBCPTP=$P($$CPT^ICPTCOD(IBCPT),"^",2)
31 .. S ^TMP("IBINACT",$J,IBSTAT,IBCPTP,IBCHECK,IBSUBH)=$P($$CPT^ICPTCOD(IBCPT),"^",3)
32 K IBCPT,IBX,IBLN,IBSTAT,IBCPTP,IBSUBH,IBCHECK
33 G:IBQ END
34 ;
35PRINT ;set up headers and dates then print
36 S IBHDR="INACTIVE CPT CODES ON CHECK-OFF SHEETS"
37 D NOW^%DTC S Y=$E(%,1,12) D DD^%DT S IBCDT=$P(Y,"@",1)_" "_$P(Y,"@",2)
38 S (IBPGN,IBLN)=0,IB3=(IOM-80)/3,IB1=IB3+20,(IB2,IB3)=IB3+24,IBDSH="" F IBI=1:1:IOM S IBDSH=IBDSH_"-"
39 D HDR,P1
40END K IBHDR,IBCDT,IBPGN,IBQ,IBLN,IBI,IB1,IB2,IB3,IBDSH,Y,X,^TMP("IBINACT",$J)
41 ;***
42 ;I $D(XRT0) S:'$D(XRTN) XRTN="IBOCOSI" D T1^%ZOSV ;stop rt clock
43 Q
44 ;
45P1 ;print the report from the temp sort file to the appropriate device
46 S IBSTAT="" F S IBSTAT=$O(^TMP("IBINACT",$J,IBSTAT)) Q:IBSTAT=""!(IBQ) S IBCPT="" D
47 . W !!,?15,$S(IBSTAT=0:"AMA INACTIVE",1:"NATIONALLY, LOCALLY AND BILLING INACTIVE"),! S IBLN=IBLN+3
48 . F S IBCPT=$O(^TMP("IBINACT",$J,IBSTAT,IBCPT)) Q:IBCPT=""!(IBQ) S IBCHECK="",IBI=1 D
49 .. F S IBCHECK=$O(^TMP("IBINACT",$J,IBSTAT,IBCPT,IBCHECK)) Q:IBCHECK=""!(IBQ) S IBSUBH="" D
50 ... F S IBSUBH=$O(^TMP("IBINACT",$J,IBSTAT,IBCPT,IBCHECK,IBSUBH)) Q:IBSUBH=""!(IBQ) D
51 .... I IBI S IBCPTP=^(IBSUBH) W !,IBCPT,?7,$E(IBCPTP,1,IB1)
52 .... 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
53 D:'IBQ PAUSE
54 K IBSTAT,IBCPT,IBCHECK,IBSUBH,IBCPTP,IBI,X,Y
55 Q
56 ;
57HDR ;print the report header
58 S IBQ=$$STOP Q:IBQ D:IBPGN>0 PAUSE Q:IBQ S IBPGN=IBPGN+1,IBLN=6
59 I IBPGN>1!($E(IOST,1,2)["C-") W @IOF
60 W IBHDR,?(IOM-30),IBCDT,?(IOM-8),"PAGE ",IBPGN,!
61 W !,"PROCEDURE",?(9+IB1),"CHECK-OFF SHEET",?(11+IB1+IB2),"SUBHEADER",! W IBDSH
62 Q
63 ;
64PAUSE ;pause at end of screen if being displayed on a terminal
65 Q:$E(IOST,1,2)'["C-" S DIR(0)="E" D ^DIR I $D(DUOUT)!($D(DIRUT)) S IBQ=1
66 K DIR,DIROUT,DTOUT,DUOUT,DIRUT
67 Q
68 ;
69STOP() ;determine if user requested task to stop
70 I $D(ZTQUEUED),$$S^%ZTLOAD S ZTSTOP=1 K ZTREQ I +$G(IBPGN) W !!,"***TASK STOPPED BY USER***",!!
71 Q +$G(ZTSTOP)
Note: See TracBrowser for help on using the repository browser.