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 ---[H[J[2J[HDG53P816 809 printed Nov 22, 2024@17:50:10 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
