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

RAIPRE1.m

Go to the documentation of this file. 
  1. RAIPRE1 ;HIRMFO/GJC- Pre-init routine ;4/19/97  12:05
  1. VERSION ;;5.0;Radiology/Nuclear Medicine;;Mar 16, 1998
  1.  ;
  1. EN1 ; Delete the Stop Codes multiple (field: 160 <|> sub-file: 71.06)
  1.  ; and associated data from the Rad/Nuc Med Procedures file (71).
  1.  Q:'($D(^DD(71.06,0))#2)  ; has been deleted in the past!
  1.  N DIC,DIU,RATXT S RATXT(1)=" "
  1.  S RATXT(2)="Deleting obsolete Stop Codes multiple from Rad/Nuc Med Procedures"
  1.  S RATXT(3)="data dictionary.  Deleting Stop Code data from the Rad/Nuc Med"
  1.  S RATXT(4)="Procedures file.  Please be patient, this may take a while."
  1.  D BMES^XPDUTL(.RATXT)
  1.  S DIU=71.06,DIU(0)="DS" D EN^DIU2
  1.  Q
  1. EN2 ; Delete the Principal Clinic field from the Imaging Locations file.
  1.  Q:'($D(^DD(79.1,75,0))#2)  ; has been deleted in the past
  1.  N %,DA,DIC,DIK,RAD0,RADD,RAFLD,RAPC,RATXT,X,Y
  1.  S RATXT(1)=" ",RAD0=0,RADD=79.1,RAFLD=75
  1.  S RATXT(2)="Deleting obsolete Principal Clinic field from Imaging Locations data"
  1.  S RATXT(3)="dictionary.  Deleting Principal Clinic data from the "
  1.  S RATXT(3)=$G(RATXT(3))_"Imaging Locations file."
  1.  D BMES^XPDUTL(.RATXT)
  1.  F  S RAD0=$O(^RA(79.1,RAD0)) Q:RAD0'>0  D
  1.  . S RAPC=$P($G(^RA(79.1,RAD0,"PC")),"^")
  1.  . D:RAPC]"" ENKILL^RAXREF(RADD,RAFLD,RAPC,.RAD0)
  1.  . K ^RA(79.1,RAD0,"PC") ; delete the data node!
  1.  . Q
  1.  S DIK="^DD(79.1,",DA(1)=RADD,DA=RAFLD D ^DIK ; delete field from DD!
  1.  Q
  1. EN4 ; Delete the Common Procedure Group field from the Rad/Nuc Med
  1.  ; Common Procedure data dictionary.  Delete Common Procedure
  1.  ; Group data from the Rad/Nuc Med Common Procedure file.
  1.  Q:'($D(^DD(71.3,2,0))#2)  ; deleted in the past.
  1.  N %,DA,DIC,DIK,RACPG,RAD0,RADD,RAFLD,RATXT,X,Y
  1.  S RATXT(1)=" ",RAD0=0,RADD=71.3,RAFLD=2
  1.  S RATXT(2)="Deleting obsolete Common Procedure Group field from Rad/Nuc Med"
  1.  S RATXT(3)="Common Procedure data dictionary.  Deleting Common Procedure"
  1.  S RATXT(4)="Group data from the Rad/Nuc Med Common Procedure file."
  1.  D BMES^XPDUTL(.RATXT)
  1.  F  S RAD0=$O(^RAMIS(RADD,RAD0)) Q:RAD0'>0  D
  1.  . S RACPG=$P($G(^RAMIS(RADD,RAD0,0)),"^",3)
  1.  . D:RACPG]"" ENKILL^RAXREF(RADD,RAFLD,RACPG,.RAD0)
  1.  . S:RACPG]"" $P(^RAMIS(RADD,RAD0,0),"^",3)=""
  1.  . Q
  1.  S DIK="^DD(71.3,",DA(1)=RADD,DA=RAFLD D ^DIK ; delete field from DD!
  1.  Q
  1. EN10 ; Delete the Input Devices multiple (field: 50 <|> sub-file: 79.11)
  1.  ; and associated data from the Imaging Locations file (79.1).
  1.  Q:'($D(^DD(79.11,0))#2)  ; has been deleted in the past!
  1.  N DIC,DIU,RATXT S RATXT(1)=" "
  1.  S RATXT(2)="Deleting obsolete Input Devices multiple from Imaging Locations"
  1.  S RATXT(3)="data dictionary.  Deleting Imaging Devices data from the"
  1.  S RATXT(4)="Imaging Locations file."
  1.  D BMES^XPDUTL(.RATXT)
  1.  S DIU=79.11,DIU(0)="DS" D EN^DIU2
  1.  K ^RA(79.1,"AD") ; delete the file-wide xref DIU2 misses!
  1.  Q
  1. EN11 ; Delete the Device Assignment Explanation word processing field (75)
  1.  ; from the Imaging Type file (79.2).  All associated data will be
  1.  ; deleted
  1.  Q:'($D(^DD(79.22,0))#2)  ; has been deleted in the past!
  1.  N DIC,DIU,RATXT S RATXT(1)=" "
  1.  S RATXT(2)="Deleting obsolete Device Assignment Explanation word processing field"
  1.  S RATXT(3)="from Imaging Type data dictionary.  Deleting Device Assignment"
  1.  S RATXT(4)="Explanation data from the Imaging type file."
  1.  D BMES^XPDUTL(.RATXT)
  1.  S DIU=79.22,DIU(0)="DS" D EN^DIU2
  1.  Q