DG53927B ;ALB/BG - TREATING SPECIALTIES UPDATES ; 5/11/16 10:51AM
;;5.3;Registration;**927**;Aug 13, 1993;Build 2
;
Q
;
EN ;
N DGTSPF,DGTSP,DGI,DGSPEC
F DGI=1:1 S DGSPEC=$P($T(TRSP+DGI),";;",2) Q:DGSPEC="QUIT" D
.S DGTSPF=+$O(^DIC(42.4,"C",DGSPEC,0)) D
..I $P(^DIC(42.4,DGTSPF,0),"^",7)=DGSPEC S DGTSP=DGTSPF D INACT
Q
INACT ;inactivate treating specialties
N DA,DIE,DR,X
S DIC="^DIC(42.4,"_DGTSP_",""E"","
S DA(1)=DGTSP
S DIC(0)="LX"
S DIC("P")=$P(^DD(42.4,10,0),"^",2)
S X=3161001
D ^DIC
S DA=+Y
I +Y=-1 D BMES^XPDUTL(">>>Inactive date not added to TS code "_DGSPEC_" in the Specialty file.<<<") Q
D BMES^XPDUTL(">>>Inactive date added to TS code "_DGSPEC_" in the Specialty file.<<<")
S DIE=DIC
S DR=".02///N"
D ^DIE
;check for CODES in the Facility Treating Specialty File (45.7)
;add inactivation date of 10/01/2016
D BMES^XPDUTL(" ")
D MES^XPDUTL(" FACILITY TREATING SPECIALTY FILE being checked to see if any entries are")
D MES^XPDUTL(" pointing to "_DGSPEC_". If so, they will be inactivated.>>>")
N DAA F DAA=0:0 S DAA=$O(^DIC(45.7,"ASPEC",DGTSP,DAA)) Q:'DAA D
.N DIE,DR,TS,X S TS=""
.S TS=$P($G(^DIC(45.7,DAA,0)),"^")
.S DIC="^DIC(45.7,"_DAA_",""E"","
.S DA(1)=DAA
.S DIC(0)="LX"
.S X=3161001
.D ^DIC
.S DA=+Y
.I +Y=-1 D BMES^XPDUTL(" Inactive date not added to "_TS_"in the Facility Treating Specialty file.") Q
.D BMES^XPDUTL(" Inactive date added to "_TS_" in the Facility Treating Specialty file.<<<")
.S DIE=DIC
.S DR=".02///N"
.D ^DIE
Q
TRSP ;PTF CODE
;;1A
;;1B
;;1C
;;1D
;;1E
;;QUIT
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDG53927B 1621 printed Sep 23, 2025@20:15:09 Page 2
DG53927B ;ALB/BG - TREATING SPECIALTIES UPDATES ; 5/11/16 10:51AM
+1 ;;5.3;Registration;**927**;Aug 13, 1993;Build 2
+2 ;
+3 QUIT
+4 ;
EN ;
+1 NEW DGTSPF,DGTSP,DGI,DGSPEC
+2 FOR DGI=1:1
SET DGSPEC=$PIECE($TEXT(TRSP+DGI),";;",2)
if DGSPEC="QUIT"
QUIT
Begin DoDot:1
+3 SET DGTSPF=+$ORDER(^DIC(42.4,"C",DGSPEC,0))
Begin DoDot:2
+4 IF $PIECE(^DIC(42.4,DGTSPF,0),"^",7)=DGSPEC
SET DGTSP=DGTSPF
DO INACT
End DoDot:2
End DoDot:1
+5 QUIT
INACT ;inactivate treating specialties
+1 NEW DA,DIE,DR,X
+2 SET DIC="^DIC(42.4,"_DGTSP_",""E"","
+3 SET DA(1)=DGTSP
+4 SET DIC(0)="LX"
+5 SET DIC("P")=$PIECE(^DD(42.4,10,0),"^",2)
+6 SET X=3161001
+7 DO ^DIC
+8 SET DA=+Y
+9 IF +Y=-1
DO BMES^XPDUTL(">>>Inactive date not added to TS code "_DGSPEC_" in the Specialty file.<<<")
QUIT
+10 DO BMES^XPDUTL(">>>Inactive date added to TS code "_DGSPEC_" in the Specialty file.<<<")
+11 SET DIE=DIC
+12 SET DR=".02///N"
+13 DO ^DIE
+14 ;check for CODES in the Facility Treating Specialty File (45.7)
+15 ;add inactivation date of 10/01/2016
+16 DO BMES^XPDUTL(" ")
+17 DO MES^XPDUTL(" FACILITY TREATING SPECIALTY FILE being checked to see if any entries are")
+18 DO MES^XPDUTL(" pointing to "_DGSPEC_". If so, they will be inactivated.>>>")
+19 NEW DAA
FOR DAA=0:0
SET DAA=$ORDER(^DIC(45.7,"ASPEC",DGTSP,DAA))
if 'DAA
QUIT
Begin DoDot:1
+20 NEW DIE,DR,TS,X
SET TS=""
+21 SET TS=$PIECE($GET(^DIC(45.7,DAA,0)),"^")
+22 SET DIC="^DIC(45.7,"_DAA_",""E"","
+23 SET DA(1)=DAA
+24 SET DIC(0)="LX"
+25 SET X=3161001
+26 DO ^DIC
+27 SET DA=+Y
+28 IF +Y=-1
DO BMES^XPDUTL(" Inactive date not added to "_TS_"in the Facility Treating Specialty file.")
QUIT
+29 DO BMES^XPDUTL(" Inactive date added to "_TS_" in the Facility Treating Specialty file.<<<")
+30 SET DIE=DIC
+31 SET DR=".02///N"
+32 DO ^DIE
End DoDot:1
+33 QUIT
TRSP ;PTF CODE
+1 ;;1A
+2 ;;1B
+3 ;;1C
+4 ;;1D
+5 ;;1E
+6 ;;QUIT
