DG53927B.m

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 ---DG53927B   1621     printed  Feb 19, 2025@00:05:21                                                                                                                                                                                                    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