DG53P816.m

DG53P816 ;ALB/MJB - FY10 TREATING SPECIALTIES ; 3/12/07 7:21am

 ;;5.3;Registration;**816**;Aug 13, 1993;Build 2

 ;

 Q

 ;

EDIT ;Edit treating specialties

 ;

 N DS,DIE,DR,DGI,DA,DGERR,DIC,DGSPEC

 S DIE="^DIC(42.4,"

 S DIC(0)="X"

 F DGI=1:1 S DGSPEC=$P($T(ETRSP+DGI),";;",2) Q:DGSPEC="QUIT"  D

 . S DGERR=0

 . S DA=$P(DGSPEC,U)

 . S DR=".01///"_$P(DGSPEC,U,2)_";1///"_$P(DGSPEC,U,3)_";3///"_$P(DGSPEC,U,4)_";4///"_$P(DGSPEC,U,5)_";5///"_$P(DGSPEC,U,6)_";6///"_$P(DGSPEC,U,7)

 . D ^DIE

 . D BMES^XPDUTL("  ")

 . D BMES^XPDUTL("  ")

 . D BMES^XPDUTL(">>>"_$P(DGSPEC,U)_" code updated to "_$P(DGSPEC,U,2)_" in the Specialty file.>>>")

 Q

ETRSP ;;PTF CODE^SPECIALTY^PRINT NAME^SERVICE^ASK PSYCH^BILLING BEDSECTION^CDR/MPCR

 ;;18^NEUROLOGY OBSERVATION^^NEUROLOGY^NO^NEUROLOGY^1151^^

 ;;QUIT

 Q

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---DG53P816   809     printed  Apr 09, 2024@21:55:31                                                                                                                                                                                                     Page 2

DG53P816  ;ALB/MJB - FY10 TREATING SPECIALTIES ; 3/12/07 7:21am

 +1       ;;5.3;Registration;**816**;Aug 13, 1993;Build 2

 +2       ;

 +3        QUIT 

 +4       ;

EDIT      ;Edit treating specialties

 +1       ;

 +2        NEW DS,DIE,DR,DGI,DA,DGERR,DIC,DGSPEC

 +3        SET DIE="^DIC(42.4,"

 +4        SET DIC(0)="X"

 +5        FOR DGI=1:1

               SET DGSPEC=$PIECE($TEXT(ETRSP+DGI),";;",2)

               if DGSPEC="QUIT"

                   QUIT 

               Begin DoDot:1

 +6                SET DGERR=0

 +7                SET DA=$PIECE(DGSPEC,U)

 +8                SET DR=".01///"_$PIECE(DGSPEC,U,2)_";1///"_$PIECE(DGSPEC,U,3)_";3///"_$PIECE(DGSPEC,U,4)_";4///"_$PIECE(DGSPEC,U,5)_";5///"_$PIECE(DGSPEC,U,6)_";6///"_$PIECE(DGSPEC,U,7)

 +9                DO ^DIE

 +10               DO BMES^XPDUTL("  ")

 +11               DO BMES^XPDUTL("  ")

 +12               DO BMES^XPDUTL(">>>"_$PIECE(DGSPEC,U)_" code updated to "_$PIECE(DGSPEC,U,2)_" in the Specialty file.>>>")

               End DoDot:1

 +13       QUIT 

ETRSP     ;;PTF CODE^SPECIALTY^PRINT NAME^SERVICE^ASK PSYCH^BILLING BEDSECTION^CDR/MPCR

 +1       ;;18^NEUROLOGY OBSERVATION^^NEUROLOGY^NO^NEUROLOGY^1151^^

 +2       ;;QUIT

 +3        QUIT