DG53927A.m

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 ---DG53927A   1424     printed  Apr 09, 2024@21:54:40                                                                                                                                                                                                    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