Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: DG53927A

DG53927A.m

Go to the documentation of this file.
  1. DG53927A ;ALB/BG - TREATING SPECIALTIE UPDATES ; 5/11/16 10:51AM
  1. ;;5.3;Registration;**927**;Aug 13, 1993;Build 2
  1. ;
  1. Q
  1. INACT ;inactivate treating specialties
  1. N DA,DIE,DR,X,DGTSP
  1. F DGTSP=23,31,33,35,57,87 D
  1. . S DIC="^DIC(42.4,"_DGTSP_",""E"","
  1. . S DA(1)=DGTSP
  1. . S DIC(0)="LX"
  1. . S DIC("P")=$P(^DD(42.4,10,0),"^",2)
  1. . S X=3161001
  1. . D ^DIC
  1. . S DA=+Y
  1. . I +Y=-1 D BMES^XPDUTL(">>>Inactive date not added to TS code "_DGTSP_" in the Specialty file.<<<") Q
  1. . D BMES^XPDUTL(">>>Inactive date added to TS code "_DGTSP_" in the Specialty file.<<<")
  1. . S DIE=DIC
  1. . S DR=".02///N"
  1. . D ^DIE
  1. . ;check for CODES in the Facility Treating Specialty File (45.7
  1. . ;add inactivation date of 2/1/2010
  1. . D BMES^XPDUTL(" ")
  1. . D MES^XPDUTL(" FACILITY TREATING SPECIALTY FILE being checked to see if any entries are")
  1. . D MES^XPDUTL(" pointing to "_DGTSP_". If so, they will be inactivated.>>>")
  1. .N DAA F DAA=0:0 S DAA=$O(^DIC(45.7,"ASPEC",DGTSP,DAA)) Q:'DAA D
  1. .. N DIE,DR,TS,X S TS=""
  1. ..S TS=$P($G(^DIC(45.7,DAA,0)),"^")
  1. ..S DIC="^DIC(45.7,"_DAA_",""E"","
  1. ..S DA(1)=DAA
  1. ..S DIC(0)="LX"
  1. ..S X=3161001
  1. ..D ^DIC
  1. ..S DA=+Y
  1. ..I +Y=-1 D BMES^XPDUTL(" Inactive date not added to "_TS_"in the Facility Treating Specialty file.") Q
  1. ..D BMES^XPDUTL(" Inactive date added to "_TS_" in the Facility Treating Specialty file.<<<")
  1. ..S DIE=DIC
  1. ..S DR=".02///N"
  1. ..D ^DIE
  1. Q