DG53927A ;ALB/BG - TREATING SPECIALTIE UPDATES ; 5/11/16 10:51AM
;;5.3;Registration;**927**;Aug 13, 1993;Build 2
;
Q
INACT ;inactivate treating specialties
N DA,DIE,DR,X,DGTSP
F DGTSP=23,31,33,35,57,87 D
. 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 "_DGTSP_" in the Specialty file.<<<") Q
. D BMES^XPDUTL(">>>Inactive date added to TS code "_DGTSP_" 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 2/1/2010
. D BMES^XPDUTL(" ")
. D MES^XPDUTL(" FACILITY TREATING SPECIALTY FILE being checked to see if any entries are")
. D MES^XPDUTL(" pointing to "_DGTSP_". 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
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDG53927A 1424 printed Nov 22, 2024@17:49:16 Page 2
DG53927A ;ALB/BG - TREATING SPECIALTIE UPDATES ; 5/11/16 10:51AM
+1 ;;5.3;Registration;**927**;Aug 13, 1993;Build 2
+2 ;
+3 QUIT
INACT ;inactivate treating specialties
+1 NEW DA,DIE,DR,X,DGTSP
+2 FOR DGTSP=23,31,33,35,57,87
Begin DoDot:1
+3 SET DIC="^DIC(42.4,"_DGTSP_",""E"","
+4 SET DA(1)=DGTSP
+5 SET DIC(0)="LX"
+6 SET DIC("P")=$PIECE(^DD(42.4,10,0),"^",2)
+7 SET X=3161001
+8 DO ^DIC
+9 SET DA=+Y
+10 IF +Y=-1
DO BMES^XPDUTL(">>>Inactive date not added to TS code "_DGTSP_" in the Specialty file.<<<")
QUIT
+11 DO BMES^XPDUTL(">>>Inactive date added to TS code "_DGTSP_" in the Specialty file.<<<")
+12 SET DIE=DIC
+13 SET DR=".02///N"
+14 DO ^DIE
+15 ;check for CODES in the Facility Treating Specialty File (45.7
+16 ;add inactivation date of 2/1/2010
+17 DO BMES^XPDUTL(" ")
+18 DO MES^XPDUTL(" FACILITY TREATING SPECIALTY FILE being checked to see if any entries are")
+19 DO MES^XPDUTL(" pointing to "_DGTSP_". If so, they will be inactivated.>>>")
+20 NEW DAA
FOR DAA=0:0
SET DAA=$ORDER(^DIC(45.7,"ASPEC",DGTSP,DAA))
if 'DAA
QUIT
Begin DoDot:2
+21 NEW DIE,DR,TS,X
SET TS=""
+22 SET TS=$PIECE($GET(^DIC(45.7,DAA,0)),"^")
+23 SET DIC="^DIC(45.7,"_DAA_",""E"","
+24 SET DA(1)=DAA
+25 SET DIC(0)="LX"
+26 SET X=3161001
+27 DO ^DIC
+28 SET DA=+Y
+29 IF +Y=-1
DO BMES^XPDUTL(" Inactive date not added to "_TS_"in the Facility Treating Specialty file.")
QUIT
+30 DO BMES^XPDUTL(" Inactive date added to "_TS_" in the Facility Treating Specialty file.<<<")
+31 SET DIE=DIC
+32 SET DR=".02///N"
+33 DO ^DIE
End DoDot:2
End DoDot:1
+34 QUIT
