RAIPRE1 ;HIRMFO/GJC- Pre-init routine ;4/19/97 12:05
VERSION ;;5.0;Radiology/Nuclear Medicine;;Mar 16, 1998
;
EN1 ; Delete the Stop Codes multiple (field: 160 <|> sub-file: 71.06)
; and associated data from the Rad/Nuc Med Procedures file (71).
Q:'($D(^DD(71.06,0))#2) ; has been deleted in the past!
N DIC,DIU,RATXT S RATXT(1)=" "
S RATXT(2)="Deleting obsolete Stop Codes multiple from Rad/Nuc Med Procedures"
S RATXT(3)="data dictionary. Deleting Stop Code data from the Rad/Nuc Med"
S RATXT(4)="Procedures file. Please be patient, this may take a while."
D BMES^XPDUTL(.RATXT)
S DIU=71.06,DIU(0)="DS" D EN^DIU2
Q
EN2 ; Delete the Principal Clinic field from the Imaging Locations file.
Q:'($D(^DD(79.1,75,0))#2) ; has been deleted in the past
N %,DA,DIC,DIK,RAD0,RADD,RAFLD,RAPC,RATXT,X,Y
S RATXT(1)=" ",RAD0=0,RADD=79.1,RAFLD=75
S RATXT(2)="Deleting obsolete Principal Clinic field from Imaging Locations data"
S RATXT(3)="dictionary. Deleting Principal Clinic data from the "
S RATXT(3)=$G(RATXT(3))_"Imaging Locations file."
D BMES^XPDUTL(.RATXT)
F S RAD0=$O(^RA(79.1,RAD0)) Q:RAD0'>0 D
. S RAPC=$P($G(^RA(79.1,RAD0,"PC")),"^")
. D:RAPC]"" ENKILL^RAXREF(RADD,RAFLD,RAPC,.RAD0)
. K ^RA(79.1,RAD0,"PC") ; delete the data node!
. Q
S DIK="^DD(79.1,",DA(1)=RADD,DA=RAFLD D ^DIK ; delete field from DD!
Q
EN4 ; Delete the Common Procedure Group field from the Rad/Nuc Med
; Common Procedure data dictionary. Delete Common Procedure
; Group data from the Rad/Nuc Med Common Procedure file.
Q:'($D(^DD(71.3,2,0))#2) ; deleted in the past.
N %,DA,DIC,DIK,RACPG,RAD0,RADD,RAFLD,RATXT,X,Y
S RATXT(1)=" ",RAD0=0,RADD=71.3,RAFLD=2
S RATXT(2)="Deleting obsolete Common Procedure Group field from Rad/Nuc Med"
S RATXT(3)="Common Procedure data dictionary. Deleting Common Procedure"
S RATXT(4)="Group data from the Rad/Nuc Med Common Procedure file."
D BMES^XPDUTL(.RATXT)
F S RAD0=$O(^RAMIS(RADD,RAD0)) Q:RAD0'>0 D
. S RACPG=$P($G(^RAMIS(RADD,RAD0,0)),"^",3)
. D:RACPG]"" ENKILL^RAXREF(RADD,RAFLD,RACPG,.RAD0)
. S:RACPG]"" $P(^RAMIS(RADD,RAD0,0),"^",3)=""
. Q
S DIK="^DD(71.3,",DA(1)=RADD,DA=RAFLD D ^DIK ; delete field from DD!
Q
EN10 ; Delete the Input Devices multiple (field: 50 <|> sub-file: 79.11)
; and associated data from the Imaging Locations file (79.1).
Q:'($D(^DD(79.11,0))#2) ; has been deleted in the past!
N DIC,DIU,RATXT S RATXT(1)=" "
S RATXT(2)="Deleting obsolete Input Devices multiple from Imaging Locations"
S RATXT(3)="data dictionary. Deleting Imaging Devices data from the"
S RATXT(4)="Imaging Locations file."
D BMES^XPDUTL(.RATXT)
S DIU=79.11,DIU(0)="DS" D EN^DIU2
K ^RA(79.1,"AD") ; delete the file-wide xref DIU2 misses!
Q
EN11 ; Delete the Device Assignment Explanation word processing field (75)
; from the Imaging Type file (79.2). All associated data will be
; deleted
Q:'($D(^DD(79.22,0))#2) ; has been deleted in the past!
N DIC,DIU,RATXT S RATXT(1)=" "
S RATXT(2)="Deleting obsolete Device Assignment Explanation word processing field"
S RATXT(3)="from Imaging Type data dictionary. Deleting Device Assignment"
S RATXT(4)="Explanation data from the Imaging type file."
D BMES^XPDUTL(.RATXT)
S DIU=79.22,DIU(0)="DS" D EN^DIU2
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRAIPRE1 3301 printed Dec 13, 2024@02:35:57 Page 2
RAIPRE1 ;HIRMFO/GJC- Pre-init routine ;4/19/97 12:05
VERSION ;;5.0;Radiology/Nuclear Medicine;;Mar 16, 1998
+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).
+2 ; has been deleted in the past!
if '($DATA(^DD(71.06,0))#2)
QUIT
+3 NEW DIC,DIU,RATXT
SET RATXT(1)=" "
+4 SET RATXT(2)="Deleting obsolete Stop Codes multiple from Rad/Nuc Med Procedures"
+5 SET RATXT(3)="data dictionary. Deleting Stop Code data from the Rad/Nuc Med"
+6 SET RATXT(4)="Procedures file. Please be patient, this may take a while."
+7 DO BMES^XPDUTL(.RATXT)
+8 SET DIU=71.06
SET DIU(0)="DS"
DO EN^DIU2
+9 QUIT
EN2 ; Delete the Principal Clinic field from the Imaging Locations file.
+1 ; has been deleted in the past
if '($DATA(^DD(79.1,75,0))#2)
QUIT
+2 NEW %,DA,DIC,DIK,RAD0,RADD,RAFLD,RAPC,RATXT,X,Y
+3 SET RATXT(1)=" "
SET RAD0=0
SET RADD=79.1
SET RAFLD=75
+4 SET RATXT(2)="Deleting obsolete Principal Clinic field from Imaging Locations data"
+5 SET RATXT(3)="dictionary. Deleting Principal Clinic data from the "
+6 SET RATXT(3)=$GET(RATXT(3))_"Imaging Locations file."
+7 DO BMES^XPDUTL(.RATXT)
+8 FOR
SET RAD0=$ORDER(^RA(79.1,RAD0))
if RAD0'>0
QUIT
Begin DoDot:1
+9 SET RAPC=$PIECE($GET(^RA(79.1,RAD0,"PC")),"^")
+10 if RAPC]""
DO ENKILL^RAXREF(RADD,RAFLD,RAPC,.RAD0)
+11 ; delete the data node!
KILL ^RA(79.1,RAD0,"PC")
+12 QUIT
End DoDot:1
+13 ; delete field from DD!
SET DIK="^DD(79.1,"
SET DA(1)=RADD
SET DA=RAFLD
DO ^DIK
+14 QUIT
EN4 ; Delete the Common Procedure Group field from the Rad/Nuc Med
+1 ; Common Procedure data dictionary. Delete Common Procedure
+2 ; Group data from the Rad/Nuc Med Common Procedure file.
+3 ; deleted in the past.
if '($DATA(^DD(71.3,2,0))#2)
QUIT
+4 NEW %,DA,DIC,DIK,RACPG,RAD0,RADD,RAFLD,RATXT,X,Y
+5 SET RATXT(1)=" "
SET RAD0=0
SET RADD=71.3
SET RAFLD=2
+6 SET RATXT(2)="Deleting obsolete Common Procedure Group field from Rad/Nuc Med"
+7 SET RATXT(3)="Common Procedure data dictionary. Deleting Common Procedure"
+8 SET RATXT(4)="Group data from the Rad/Nuc Med Common Procedure file."
+9 DO BMES^XPDUTL(.RATXT)
+10 FOR
SET RAD0=$ORDER(^RAMIS(RADD,RAD0))
if RAD0'>0
QUIT
Begin DoDot:1
+11 SET RACPG=$PIECE($GET(^RAMIS(RADD,RAD0,0)),"^",3)
+12 if RACPG]""
DO ENKILL^RAXREF(RADD,RAFLD,RACPG,.RAD0)
+13 if RACPG]""
SET $PIECE(^RAMIS(RADD,RAD0,0),"^",3)=""
+14 QUIT
End DoDot:1
+15 ; delete field from DD!
SET DIK="^DD(71.3,"
SET DA(1)=RADD
SET DA=RAFLD
DO ^DIK
+16 QUIT
EN10 ; Delete the Input Devices multiple (field: 50 <|> sub-file: 79.11)
+1 ; and associated data from the Imaging Locations file (79.1).
+2 ; has been deleted in the past!
if '($DATA(^DD(79.11,0))#2)
QUIT
+3 NEW DIC,DIU,RATXT
SET RATXT(1)=" "
+4 SET RATXT(2)="Deleting obsolete Input Devices multiple from Imaging Locations"
+5 SET RATXT(3)="data dictionary. Deleting Imaging Devices data from the"
+6 SET RATXT(4)="Imaging Locations file."
+7 DO BMES^XPDUTL(.RATXT)
+8 SET DIU=79.11
SET DIU(0)="DS"
DO EN^DIU2
+9 ; delete the file-wide xref DIU2 misses!
KILL ^RA(79.1,"AD")
+10 QUIT
EN11 ; Delete the Device Assignment Explanation word processing field (75)
+1 ; from the Imaging Type file (79.2). All associated data will be
+2 ; deleted
+3 ; has been deleted in the past!
if '($DATA(^DD(79.22,0))#2)
QUIT
+4 NEW DIC,DIU,RATXT
SET RATXT(1)=" "
+5 SET RATXT(2)="Deleting obsolete Device Assignment Explanation word processing field"
+6 SET RATXT(3)="from Imaging Type data dictionary. Deleting Device Assignment"
+7 SET RATXT(4)="Explanation data from the Imaging type file."
+8 DO BMES^XPDUTL(.RATXT)
+9 SET DIU=79.22
SET DIU(0)="DS"
DO EN^DIU2
+10 QUIT
