ICPTSR1 ;ALB/ABR,MRY - CPT IENS - REV CPT CODES ; 1/3/03 2:38pm
;;6.0;CPT/HCPCS;**3,4,8,9,12,13**;May 19, 1997
;
; This routine points to the ien's of the REVISED CPT codes for 2003
; It is used by the print option, in routine ICPTPRN to create a
; temporary global to sort by.
;
START ; CREATE GLOBAL
N ICPTN,ICPTTMP,ICPTX,I,J
F J=2:1:3 S END=0 D
. F I=1:1 S FILE="TEXT+"_I_"^ICPTSR"_J D Q:END
.. S ICPTX=$P($T(@FILE),";",3)
.. I ICPTX["$END" S END=1 Q
.. S ICPTN=$S(+ICPTX:+ICPTX,1:""""_$P(ICPTX,U)_"""")
.. S ICPTTMP="^TMP(""REVCPT"",$J,"_ICPTN_","_$P(ICPTX,U,2)_")"
.. S @ICPTTMP=""
;D ^ICPTSR2 ; next part of codes
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HICPTSR1 666 printed Dec 13, 2024@01:45:48 Page 2
ICPTSR1 ;ALB/ABR,MRY - CPT IENS - REV CPT CODES ; 1/3/03 2:38pm
+1 ;;6.0;CPT/HCPCS;**3,4,8,9,12,13**;May 19, 1997
+2 ;
+3 ; This routine points to the ien's of the REVISED CPT codes for 2003
+4 ; It is used by the print option, in routine ICPTPRN to create a
+5 ; temporary global to sort by.
+6 ;
START ; CREATE GLOBAL
+1 NEW ICPTN,ICPTTMP,ICPTX,I,J
+2 FOR J=2:1:3
SET END=0
Begin DoDot:1
+3 FOR I=1:1
SET FILE="TEXT+"_I_"^ICPTSR"_J
Begin DoDot:2
+4 SET ICPTX=$PIECE($TEXT(@FILE),";",3)
+5 IF ICPTX["$END"
SET END=1
QUIT
+6 SET ICPTN=$SELECT(+ICPTX:+ICPTX,1:""""_$PIECE(ICPTX,U)_"""")
+7 SET ICPTTMP="^TMP(""REVCPT"",$J,"_ICPTN_","_$PIECE(ICPTX,U,2)_")"
+8 SET @ICPTTMP=""
End DoDot:2
if END
QUIT
End DoDot:1
+9 ;D ^ICPTSR2 ; next part of codes
+10 QUIT
+11 ;
