- 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 Dec 13, 2024@02:39:17 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