| 1 | ICPTPRN ;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;Build 1
|
|---|
| 3 | ;
|
|---|
| 4 | ;modified to sort in code name order using temp global;abr 1/96
|
|---|
| 5 | ;
|
|---|
| 6 | ;
|
|---|
| 7 | AM3 ;-- 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 | ;
|
|---|
| 19 | AM4 ;-- 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 | ;
|
|---|
| 27 | AM5 ;-- 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 | ;
|
|---|
| 38 | INIT ;--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
|
|---|
| 45 | PRTQ ;--clean-up and exit
|
|---|
| 46 | K DHD,FLDS,L,DIC,BY,DIS,ICPTX,ICPTY,ICPTK
|
|---|
| 47 | Q
|
|---|
| 48 | ;
|
|---|
| 49 | CPTMOD ; --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
|
|---|
