source: FOIAVistA/trunk/r/EVENT_CAPTURE-EC--ECT--ECX/ECINCPT.m@ 1757

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

initial load of FOIAVistA 6/30/08 version

File size: 1.3 KB
Line 
1ECINCPT ;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
5EN ;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
15START ; 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
30HEADER ;
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
39PAGE ;
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
Note: See TracBrowser for help on using the repository browser.