DG53P961 ;MNT/DTA - FY19 INACTIVATE TREATING SPECIALTIES ;6/21/18
;;5.3;Registration;**961**;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=3181001
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/2018
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 DGDAA F DGDAA=0:0 S DGDAA=$O(^DIC(45.7,"ASPEC",DGTSP,DGDAA)) Q:'DGDAA D
.N DIE,DR,DGTS,X S DGTS=""
.S DGTS=$P($G(^DIC(45.7,DGDAA,0)),"^")
.S DIC="^DIC(45.7,"_DGDAA_",""E"","
.S DA(1)=DGDAA
.S DIC(0)="LX"
.S X=3181001
.D ^DIC
.S DA=+Y
.I +Y=-1 D BMES^XPDUTL(" Inactive date not added to "_DGTS_"in the Facility Treating Specialty file.") Q
.D BMES^XPDUTL(" Inactive date added to "_DGTS_" in the Facility Treating Specialty file.<<<")
.S DIE=DIC
.S DR=".02///N"
.D ^DIE
Q
TRSP ;PTF CODE
;;5
;;1K
;;1L
;;1M
;;QUIT
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDG53P961 1639 printed Dec 13, 2024@02:40:28 Page 2
DG53P961 ;MNT/DTA - FY19 INACTIVATE TREATING SPECIALTIES ;6/21/18
+1 ;;5.3;Registration;**961**;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=3181001
+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/2018
+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 DGDAA
FOR DGDAA=0:0
SET DGDAA=$ORDER(^DIC(45.7,"ASPEC",DGTSP,DGDAA))
if 'DGDAA
QUIT
Begin DoDot:1
+20 NEW DIE,DR,DGTS,X
SET DGTS=""
+21 SET DGTS=$PIECE($GET(^DIC(45.7,DGDAA,0)),"^")
+22 SET DIC="^DIC(45.7,"_DGDAA_",""E"","
+23 SET DA(1)=DGDAA
+24 SET DIC(0)="LX"
+25 SET X=3181001
+26 DO ^DIC
+27 SET DA=+Y
+28 IF +Y=-1
DO BMES^XPDUTL(" Inactive date not added to "_DGTS_"in the Facility Treating Specialty file.")
QUIT
+29 DO BMES^XPDUTL(" Inactive date added to "_DGTS_" 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 ;;5
+2 ;;1K
+3 ;;1L
+4 ;;1M
+5 ;;QUIT
