ICPTPRN ;ALB/MTC,RMO,ABR,MRY - CPT PRINT-OUT DRIVER ; 1/03/03 3:21pm
;;6.0;CPT/HCPCS;**4,8,9,12,13**;May 19, 1997
;
;modified to sort in code name order using temp global;abr 1/96
;
;
AM3 ;-- Recently Inactivated CPT Codes
N DGDATE,FR,TO,BY
D INIT
S DHD="Recently INACTIVATED CPT Codes effective Jan 01, 2003"
; rev w/new Inactive Date - changed 2990401 to 3000401 (ERC)
; 3010401 (JKT)
; 3020401 (JT)
; 3030101 (MRY)
S BY="[ICPT NEW/INACTIVE CODES]",(FR,TO)="3030101,1,"
D EN1^DIP
G PRTQ
;
AM4 ;-- New CPT Codes
N DGDATE,FR,TO,BY
D INIT
S DHD="NEW CPT Codes effective "_$P(DGDATE,U,2)
S BY="[ICPT NEW/INACTIVE CODES]",FR=+DGDATE_",@,",TO=+DGDATE_",@,"
D EN1^DIP
G PRTQ
;
AM5 ;-- Revised CPT Codes
N DGDATE,DGSRT,FR,TO,BY
K ^TMP("REVCPT",$J)
S DGSRT="REVCPT"
D ^ICPTSR1 ; sorts by revised codes
D INIT
S BY(0)="^TMP(""REVCPT"",$J,",L(0)=2,DHD="Recently REVISED CPT Codes effective "_$P(DGDATE,U,2)
D EN1^DIP
K ^TMP("REVCPT",$J)
G PRTQ
;
INIT ;--init common items for print routines
N X,Y
S (X,DGDATE)=$$CPTDIST^ICPTAPIU,Y="D"
S $P(DGDATE,U,2)=$$FMTE^XLFDT(X)
W !,$C(7),"This report requires 132 columns."
S L=0,DIC="^ICPT(",FLDS="[ICPT PRINT]"
Q
PRTQ ;--clean-up and exit
K DHD,FLDS,L,DIC,BY,DIS,ICPTX,ICPTY,ICPTK
Q
;
CPTMOD ; --Modifiers for a range
;
NEW DIC,L,FLDS,BY
S DIC="^DIC(81.3,",L=0,FLDS="[ICPT MODIFIERS BY RANGE]",BY="[ICPT MODIFIERS FOR RANGE]"
W !,$C(7),"This report requires 132 columns."
D EN1^DIP
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HICPTPRN 1655 printed Dec 13, 2024@01:45:47 Page 2
ICPTPRN ;ALB/MTC,RMO,ABR,MRY - CPT PRINT-OUT DRIVER ; 1/03/03 3:21pm
+1 ;;6.0;CPT/HCPCS;**4,8,9,12,13**;May 19, 1997
+2 ;
+3 ;modified to sort in code name order using temp global;abr 1/96
+4 ;
+5 ;
AM3 ;-- Recently Inactivated CPT Codes
+1 NEW DGDATE,FR,TO,BY
+2 DO INIT
+3 SET DHD="Recently INACTIVATED CPT Codes effective Jan 01, 2003"
+4 ; rev w/new Inactive Date - changed 2990401 to 3000401 (ERC)
+5 ; 3010401 (JKT)
+6 ; 3020401 (JT)
+7 ; 3030101 (MRY)
+8 SET BY="[ICPT NEW/INACTIVE CODES]"
SET (FR,TO)="3030101,1,"
+9 DO EN1^DIP
+10 GOTO PRTQ
+11 ;
AM4 ;-- New CPT Codes
+1 NEW DGDATE,FR,TO,BY
+2 DO INIT
+3 SET DHD="NEW CPT Codes effective "_$PIECE(DGDATE,U,2)
+4 SET BY="[ICPT NEW/INACTIVE CODES]"
SET FR=+DGDATE_",@,"
SET TO=+DGDATE_",@,"
+5 DO EN1^DIP
+6 GOTO PRTQ
+7 ;
AM5 ;-- Revised CPT Codes
+1 NEW DGDATE,DGSRT,FR,TO,BY
+2 KILL ^TMP("REVCPT",$JOB)
+3 SET DGSRT="REVCPT"
+4 ; sorts by revised codes
DO ^ICPTSR1
+5 DO INIT
+6 SET BY(0)="^TMP(""REVCPT"",$J,"
SET L(0)=2
SET DHD="Recently REVISED CPT Codes effective "_$PIECE(DGDATE,U,2)
+7 DO EN1^DIP
+8 KILL ^TMP("REVCPT",$JOB)
+9 GOTO PRTQ
+10 ;
INIT ;--init common items for print routines
+1 NEW X,Y
+2 SET (X,DGDATE)=$$CPTDIST^ICPTAPIU
SET Y="D"
+3 SET $PIECE(DGDATE,U,2)=$$FMTE^XLFDT(X)
+4 WRITE !,$CHAR(7),"This report requires 132 columns."
+5 SET L=0
SET DIC="^ICPT("
SET FLDS="[ICPT PRINT]"
+6 QUIT
PRTQ ;--clean-up and exit
+1 KILL DHD,FLDS,L,DIC,BY,DIS,ICPTX,ICPTY,ICPTK
+2 QUIT
+3 ;
CPTMOD ; --Modifiers for a range
+1 ;
+2 NEW DIC,L,FLDS,BY
+3 SET DIC="^DIC(81.3,"
SET L=0
SET FLDS="[ICPT MODIFIERS BY RANGE]"
SET BY="[ICPT MODIFIERS FOR RANGE]"
+4 WRITE !,$CHAR(7),"This report requires 132 columns."
+5 DO EN1^DIP
+6 QUIT
