ICPT65PT.m

ICPT65PT ;ALB/ABR - CORRECT SHORT DESCRIPTIONS - 1999 ;   MARCH 2 1999

 ;;6.0;CPT/HCPCS;**5**;May 19, 1997

 ;

 ;  Post-install to correct specified short names in CPT (#81) file 

 ;

EN ;

 N ICPTI,ICPTX,DIE,DR,DA,ERR

 S DIE="^ICPT("

 F ICPTI=1:1 S ICPTX=$P($T(CPTSN+ICPTI),";;",2) Q:ICPTX["$END"  D  Q:$D(ERR)

 . S DA=+ICPTX,DR="2///"_$P(ICPTX,U,2)

 . I '$D(^ICPT(DA,0)) S ERR="CHECK CPT GLOBAL.  UNABLE TO UPDATE" Q

 . D ^DIE

 ;

 I $D(ERR) D BMES^XPDUTL(ERR)

 Q

 ;

CPTSN ;

 ;;64623^INJECT, TX OF NERVE ADD-ON

 ;;82544^COLUMN CHROMOTOGRAPH/ISOTOPE

 ;;$END

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---ICPT65PT   575     printed  Oct 16, 2024@17:46:27                                                                                                                                                                                                     Page 2

ICPT65PT  ;ALB/ABR - CORRECT SHORT DESCRIPTIONS - 1999 ;   MARCH 2 1999

 +1       ;;6.0;CPT/HCPCS;**5**;May 19, 1997

 +2       ;

 +3       ;  Post-install to correct specified short names in CPT (#81) file 

 +4       ;

EN        ;

 +1        NEW ICPTI,ICPTX,DIE,DR,DA,ERR

 +2        SET DIE="^ICPT("

 +3        FOR ICPTI=1:1

               SET ICPTX=$PIECE($TEXT(CPTSN+ICPTI),";;",2)

               if ICPTX["$END"

                   QUIT 

               Begin DoDot:1

 +4                SET DA=+ICPTX

                   SET DR="2///"_$PIECE(ICPTX,U,2)

 +5                IF '$DATA(^ICPT(DA,0))

                       SET ERR="CHECK CPT GLOBAL.  UNABLE TO UPDATE"

                       QUIT 

 +6                DO ^DIE

               End DoDot:1

               if $DATA(ERR)

                   QUIT 

 +7       ;

 +8        IF $DATA(ERR)

               DO BMES^XPDUTL(ERR)

 +9        QUIT 

 +10      ;

CPTSN     ;

 +1       ;;64623^INJECT, TX OF NERVE ADD-ON

 +2       ;;82544^COLUMN CHROMOTOGRAPH/ISOTOPE

 +3       ;;$END