source: FOIAVistA/trunk/r/CPT_HCPCS_CODES-ICPT-DGYA/ICPTPRN.m@ 811

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

initial load of FOIAVistA 6/30/08 version

File size: 1.6 KB
Line 
1ICPTPRN ;ALB/MTC,RMO,ABR,MRY - CPT PRINT-OUT DRIVER ; 1/03/03 3:21pm
2 ;;6.0;CPT/HCPCS;**4,8,9,12,13**;May 19, 1997
3 ;
4 ;modified to sort in code name order using temp global;abr 1/96
5 ;
6 ;
7AM3 ;-- Recently Inactivated CPT Codes
8 N DGDATE,FR,TO,BY
9 D INIT
10 S DHD="Recently INACTIVATED CPT Codes effective Jan 01, 2003"
11 ; rev w/new Inactive Date - changed 2990401 to 3000401 (ERC)
12 ; 3010401 (JKT)
13 ; 3020401 (JT)
14 ; 3030101 (MRY)
15 S BY="[ICPT NEW/INACTIVE CODES]",(FR,TO)="3030101,1,"
16 D EN1^DIP
17 G PRTQ
18 ;
19AM4 ;-- New CPT Codes
20 N DGDATE,FR,TO,BY
21 D INIT
22 S DHD="NEW CPT Codes effective "_$P(DGDATE,U,2)
23 S BY="[ICPT NEW/INACTIVE CODES]",FR=+DGDATE_",@,",TO=+DGDATE_",@,"
24 D EN1^DIP
25 G PRTQ
26 ;
27AM5 ;-- Revised CPT Codes
28 N DGDATE,DGSRT,FR,TO,BY
29 K ^TMP("REVCPT",$J)
30 S DGSRT="REVCPT"
31 D ^ICPTSR1 ; sorts by revised codes
32 D INIT
33 S BY(0)="^TMP(""REVCPT"",$J,",L(0)=2,DHD="Recently REVISED CPT Codes effective "_$P(DGDATE,U,2)
34 D EN1^DIP
35 K ^TMP("REVCPT",$J)
36 G PRTQ
37 ;
38INIT ;--init common items for print routines
39 N X,Y
40 S (X,DGDATE)=$$CPTDIST^ICPTAPIU,Y="D"
41 S $P(DGDATE,U,2)=$$FMTE^XLFDT(X)
42 W !,$C(7),"This report requires 132 columns."
43 S L=0,DIC="^ICPT(",FLDS="[ICPT PRINT]"
44 Q
45PRTQ ;--clean-up and exit
46 K DHD,FLDS,L,DIC,BY,DIS,ICPTX,ICPTY,ICPTK
47 Q
48 ;
49CPTMOD ; --Modifiers for a range
50 ;
51 NEW DIC,L,FLDS,BY
52 S DIC="^DIC(81.3,",L=0,FLDS="[ICPT MODIFIERS BY RANGE]",BY="[ICPT MODIFIERS FOR RANGE]"
53 W !,$C(7),"This report requires 132 columns."
54 D EN1^DIP
55 Q
Note: See TracBrowser for help on using the repository browser.