| 1 | ECINCPT ;ALB/JAM-Procedure Codes with Inactive CPTs Report ; 08/01/05
|
|---|
| 2 | ;;2.0; EVENT CAPTURE ;**72**;8 May 96
|
|---|
| 3 | ; Routine to report National/Local Procedure Codes with Inactive CPT
|
|---|
| 4 | ; Codes Report
|
|---|
| 5 | EN ;entry point
|
|---|
| 6 | N ZTIO,ZTDESC,ZTRTN,ECPG,ECOUT
|
|---|
| 7 | S ZTIO=ION
|
|---|
| 8 | S ZTDESC="NATIONAL/LOCAL PROCEDURE CODES WITH INACTIVE CPT"
|
|---|
| 9 | S ZTRTN="START^ECINCPT"
|
|---|
| 10 | D EN^XUTMDEVQ(ZTRTN,ZTDESC,.ZTSAVE)
|
|---|
| 11 | I POP Q
|
|---|
| 12 | I IO'=IO(0) D ^%ZISC
|
|---|
| 13 | D HOME^%ZIS
|
|---|
| 14 | Q
|
|---|
| 15 | START ; Routine execution
|
|---|
| 16 | N ECI,EC0,ECPT,ECN,ECD,ECPI,ECDT,ECPG,ECOUT,ECRDT
|
|---|
| 17 | S (ECI,ECOUT)=0,ECPG=1
|
|---|
| 18 | S %H=$H S ECRDT=$$HTE^XLFDT(%H,1)
|
|---|
| 19 | D HEADER
|
|---|
| 20 | F S ECI=$O(^EC(725,ECI)) Q:'ECI D I ECOUT Q
|
|---|
| 21 | .S EC0=$G(^EC(725,ECI,0)),ECPT=$P(EC0,"^",5)
|
|---|
| 22 | .Q:EC0="" Q:ECPT=""
|
|---|
| 23 | .S ECN=$P(EC0,"^",2),ECD=$P(EC0,"^"),ECPI=$$CPT^ICPTCOD(ECPT)
|
|---|
| 24 | .Q:+ECPI<1 Q:$P(ECPI,"^",7)
|
|---|
| 25 | .S ECDT=$TR($$FMTE^XLFDT($P(ECPI,"^",8),"2F")," ","0")
|
|---|
| 26 | .I ($Y+3)>IOSL D PAGE Q:ECOUT D HEADER
|
|---|
| 27 | .W !,ECN,?10,ECD,?60,$P(ECPI,"^",2),?68,ECDT
|
|---|
| 28 | I 'ECOUT D PAGE
|
|---|
| 29 | Q
|
|---|
| 30 | HEADER ;
|
|---|
| 31 | W:$E(IOST,1,2)="C-"!(ECPG>1) @IOF
|
|---|
| 32 | W !!,"NATIONAL/LOCAL PROCEDURE CODES WITH INACTIVE CPT CODES"
|
|---|
| 33 | W ?68,"Page: ",ECPG,!?25,"Run Date : ",ECRDT,!
|
|---|
| 34 | W "National",?60,"CPT",?68,"Inactive",!
|
|---|
| 35 | W "Number",?10,"National Name",?60,"Code",?68,"Date",!
|
|---|
| 36 | S ECPG=ECPG+1
|
|---|
| 37 | F I=1:1:80 W "-"
|
|---|
| 38 | Q
|
|---|
| 39 | PAGE ;
|
|---|
| 40 | N SS,JJ
|
|---|
| 41 | I $D(ECPG),$E(IOST,1,2)="C-" D
|
|---|
| 42 | . S SS=22-$Y F JJ=1:1:SS W !
|
|---|
| 43 | . S DIR(0)="E" W ! D ^DIR K DIR I 'Y S ECOUT=1
|
|---|
| 44 | Q
|
|---|
