RAIPRE2 ;HIRMFO/GJC- Pre-init routine ;10/23/97 09:30
VERSION ;;5.0;Radiology/Nuclear Medicine;;Mar 16, 1998
;
EN1 ; Delete the Allow 'VA' Patient Entry field from the Rad/Nuc Med
; Division data dictionary. Delete Allow 'VA' Patient Entry data
; from the Rad/Nuc Med Division file.
Q:'($D(^DD(79,.13,0))#2) ; deleted in the past.
N %,DA,DIC,DIK,RALL,RAD0,RADD,RAFLD,RATXT,X,Y
S RATXT(1)=" ",RAD0=0,RADD=79,RAFLD=.13
S RATXT(2)="Deleting obsolete Allow 'VA' Patient Entry field from Rad/"
S RATXT(3)="Nuc Med Division data dictionary. Deleting Allow 'VA'"
S RATXT(4)="Patient Entry data from the Rad/Nuc Med Division file."
D BMES^XPDUTL(.RATXT)
F S RAD0=$O(^RA(79,RAD0)) Q:RAD0'>0 D
. S RALL=$P($G(^RA(79,RAD0,.1)),"^",3)
. D:RALL]"" ENKILL^RAXREF(RADD,RAFLD,RALL,.RAD0)
. S:RALL]"" $P(^RA(79,RAD0,.1),"^",3)=""
. Q
S DIK="^DD(79,",DA(1)=RADD,DA=RAFLD D ^DIK ; delete field from DD!
Q
EN2 ; Delete the Allow 'NON-VA' Patient Entry field from the Rad/Nuc Med
; Division data dictionary. Delete Allow 'NON-VA' Patient Entry data
; from the Rad/Nuc Med Division file.
Q:'($D(^DD(79,.14,0))#2) ; deleted in the past.
N %,DA,DIC,DIK,RALLN,RAD0,RADD,RAFLD,RATXT,X,Y
S RATXT(1)=" ",RAD0=0,RADD=79,RAFLD=.14
S RATXT(2)="Deleting obsolete Allow 'NON-VA' Patient Entry field from"
S RATXT(3)="Rad/Nuc Med Division data dictionary. Deleting Allow 'NON-"
S RATXT(4)="VA' Patient Entry data from the Rad/Nuc Med Division file."
D BMES^XPDUTL(.RATXT)
F S RAD0=$O(^RA(79,RAD0)) Q:RAD0'>0 D
. S RALLN=$P($G(^RA(79,RAD0,.1)),"^",4)
. D:RALLN]"" ENKILL^RAXREF(RADD,RAFLD,RALLN,.RAD0)
. S:RALLN]"" $P(^RA(79,RAD0,.1),"^",4)=""
. Q
S DIK="^DD(79,",DA(1)=RADD,DA=RAFLD D ^DIK ; delete field from DD!
Q
EN3 ; Delete the Ask 'Requesting Physician' field from the Rad/Nuc Med
; Division data dictionary. Delete Ask 'Requesting Physician' data
; from the Rad/Nuc Med Division file.
Q:'($D(^DD(79,.15,0))#2) ; deleted in the past.
N %,DA,DIC,DIK,RAD0,RADD,RAFLD,RAREQ,RATXT,X,Y
S RATXT(1)=" ",RAD0=0,RADD=79,RAFLD=.15
S RATXT(2)="Deleting obsolete Ask 'Requesting Physician' field from"
S RATXT(3)="Rad/Nuc Med Division data dictionary. Deleting Ask 'Requ-"
S RATXT(4)="esting Physician' data from the Rad/Nuc Med Division file."
D BMES^XPDUTL(.RATXT)
F S RAD0=$O(^RA(79,RAD0)) Q:RAD0'>0 D
. S RAREQ=$P($G(^RA(79,RAD0,.1)),"^",5)
. D:RAREQ]"" ENKILL^RAXREF(RADD,RAFLD,RAREQ,.RAD0)
. S:RAREQ]"" $P(^RA(79,RAD0,.1),"^",5)=""
. Q
S DIK="^DD(79,",DA(1)=RADD,DA=RAFLD D ^DIK ; delete field from DD!
Q
EN4 ; Delete the following fields from the Rad/Nuc Med Division
; data dictionary: Last DFN Converted (75.1), Conversion Start
; Time (75.1), Conversion Stop Time (75.1), Last DFN Converted
; (70), Conversion Start Time (70) & Conversion Stop Time (70).
; All data associated with these fields will be deleted.
N RADD,RAXIST S RADD=79,RAXIST=0
F RAFLD=2300.1:.1:2300.6 S:$D(^DD(RADD,RAFLD,0)) RAXIST=1
Q:'RAXIST ; fields have already been deleted!
N %,DA,DIC,DIK,RAD0,RADATA,RAFILE,RAFLD,RAFLDTXT,RATXT,X,Y S RAD0=0
S RAFILE=$S($D(^DIC(RADD,0))#2:$P(^(0),"^"),1:"Unknown")
F S RAD0=$O(^RA(RADD,RAD0)) Q:RAD0'>0 D
. F RAFLD=2300.1:.1:2300.6 D
.. S RAFLDTXT=$S($D(^DD(RADD,RAFLD,0))#2:$P(^(0),"^"),1:"Unknown")
.. Q:RAFLDTXT="Unknown" ; unidentified field
.. S RADATA=$P($G(^RA(RADD,RAD0,"PATCH23")),"^",$P(RAFLD,".",2))
.. D:RADATA]"" ENKILL^RAXREF(RADD,RAFLD,RADATA,.RAD0)
.. S:RADATA]"" $P(^RA(RADD,RAD0,"PATCH23"),"^",$P(RAFLD,".",2))=""
.. S RATXT(1)=" ",RATXT(2)="Deleting obsolete "_RAFLDTXT_" field from"
.. S RATXT(3)=RAFILE_" data dictionary."
.. S RATXT(4)="Deleting "_RAFLDTXT_" data from the"
.. S RATXT(5)=RAFILE_" file. Division: "_$$GET1^DIQ(4,RAD0_",",.01)
.. D BMES^XPDUTL(.RATXT)
.. S DIK="^DD("_RADD_",",DA(1)=RADD,DA=RAFLD D ^DIK ; delete field!
.. Q
. K %,DA,DIC,DIK,X,Y K ^RA(RADD,RAD0,"PATCH23") ; kill off data node
. Q
Q
EN5 ; Change the name of 'Radiology Location' in the Label Print Fields
; file (78.7) to 'Imaging Location'.
Q:+$O(^RA(78.7,"B","IMAGING LOCATION",0)) ; 'Imaging Location' exists
N RADLOC,RAFDA,RATXT S RATXT(1)=""
S RATXT(2)="Changing name of Label Print Field (file: 78.7)"
S RATXT(3)="from: 'RADIOLOGY LOCATION' to 'IMAGING LOCATION'"
S RADLOC=+$O(^RA(78.7,"B","RADIOLOGY LOCATION",0))
Q:'RADLOC D MES^XPDUTL(.RATXT)
S RAFDA(78.7,RADLOC_",",.01)="IMAGING LOCATION"
D FILE^DIE("","RAFDA","")
Q
EN7 ; Un-compile the 'RA STATUS CHANGE' & 'RA EXAM EDIT' input templates
; on the Rad/Nuc Med Patient file.
; Variable Definition:
; RAEXED -> ien of the RA EXAM EDIT template
; RASTCH -> ien of the RA STATUS CHANGE template
; RATXT -> array which contains the message displayed to the user
;
N RAEXED,RASTCH,RATXT
S RASTCH=$$FIND1^DIC(.402,"","X","RA STATUS CHANGE")
I RASTCH D ; the input template exists
. D TMPMSG("RA STATUS CHANGE"),MES^XPDUTL(.RATXT),UNC^DIEZ(RASTCH,"D")
. Q
S RAEXED=$$FIND1^DIC(.402,"","X","RA EXAM EDIT")
I RAEXED K RATXT D ; the input template exists
. D TMPMSG("RA EXAM EDIT"),MES^XPDUTL(.RATXT),UNC^DIEZ(RAEXED,"D")
. Q
Q
TMPMSG(X) ; Build the text array for each specific compiled input
; template.
; Input: X-the name of the input template
S RATXT(1)=""
S RATXT(2)="Un-compiling the `"_X_"' input template on the"
S RATXT(3)="Rad/Nuc Med Patient file. All the compiled templates"
S RATXT(4)="associated with `"_X_"' will be deleted."
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRAIPRE2 5530 printed Dec 13, 2024@02:35:58 Page 2
RAIPRE2 ;HIRMFO/GJC- Pre-init routine ;10/23/97 09:30
VERSION ;;5.0;Radiology/Nuclear Medicine;;Mar 16, 1998
+1 ;
EN1 ; Delete the Allow 'VA' Patient Entry field from the Rad/Nuc Med
+1 ; Division data dictionary. Delete Allow 'VA' Patient Entry data
+2 ; from the Rad/Nuc Med Division file.
+3 ; deleted in the past.
if '($DATA(^DD(79,.13,0))#2)
QUIT
+4 NEW %,DA,DIC,DIK,RALL,RAD0,RADD,RAFLD,RATXT,X,Y
+5 SET RATXT(1)=" "
SET RAD0=0
SET RADD=79
SET RAFLD=.13
+6 SET RATXT(2)="Deleting obsolete Allow 'VA' Patient Entry field from Rad/"
+7 SET RATXT(3)="Nuc Med Division data dictionary. Deleting Allow 'VA'"
+8 SET RATXT(4)="Patient Entry data from the Rad/Nuc Med Division file."
+9 DO BMES^XPDUTL(.RATXT)
+10 FOR
SET RAD0=$ORDER(^RA(79,RAD0))
if RAD0'>0
QUIT
Begin DoDot:1
+11 SET RALL=$PIECE($GET(^RA(79,RAD0,.1)),"^",3)
+12 if RALL]""
DO ENKILL^RAXREF(RADD,RAFLD,RALL,.RAD0)
+13 if RALL]""
SET $PIECE(^RA(79,RAD0,.1),"^",3)=""
+14 QUIT
End DoDot:1
+15 ; delete field from DD!
SET DIK="^DD(79,"
SET DA(1)=RADD
SET DA=RAFLD
DO ^DIK
+16 QUIT
EN2 ; Delete the Allow 'NON-VA' Patient Entry field from the Rad/Nuc Med
+1 ; Division data dictionary. Delete Allow 'NON-VA' Patient Entry data
+2 ; from the Rad/Nuc Med Division file.
+3 ; deleted in the past.
if '($DATA(^DD(79,.14,0))#2)
QUIT
+4 NEW %,DA,DIC,DIK,RALLN,RAD0,RADD,RAFLD,RATXT,X,Y
+5 SET RATXT(1)=" "
SET RAD0=0
SET RADD=79
SET RAFLD=.14
+6 SET RATXT(2)="Deleting obsolete Allow 'NON-VA' Patient Entry field from"
+7 SET RATXT(3)="Rad/Nuc Med Division data dictionary. Deleting Allow 'NON-"
+8 SET RATXT(4)="VA' Patient Entry data from the Rad/Nuc Med Division file."
+9 DO BMES^XPDUTL(.RATXT)
+10 FOR
SET RAD0=$ORDER(^RA(79,RAD0))
if RAD0'>0
QUIT
Begin DoDot:1
+11 SET RALLN=$PIECE($GET(^RA(79,RAD0,.1)),"^",4)
+12 if RALLN]""
DO ENKILL^RAXREF(RADD,RAFLD,RALLN,.RAD0)
+13 if RALLN]""
SET $PIECE(^RA(79,RAD0,.1),"^",4)=""
+14 QUIT
End DoDot:1
+15 ; delete field from DD!
SET DIK="^DD(79,"
SET DA(1)=RADD
SET DA=RAFLD
DO ^DIK
+16 QUIT
EN3 ; Delete the Ask 'Requesting Physician' field from the Rad/Nuc Med
+1 ; Division data dictionary. Delete Ask 'Requesting Physician' data
+2 ; from the Rad/Nuc Med Division file.
+3 ; deleted in the past.
if '($DATA(^DD(79,.15,0))#2)
QUIT
+4 NEW %,DA,DIC,DIK,RAD0,RADD,RAFLD,RAREQ,RATXT,X,Y
+5 SET RATXT(1)=" "
SET RAD0=0
SET RADD=79
SET RAFLD=.15
+6 SET RATXT(2)="Deleting obsolete Ask 'Requesting Physician' field from"
+7 SET RATXT(3)="Rad/Nuc Med Division data dictionary. Deleting Ask 'Requ-"
+8 SET RATXT(4)="esting Physician' data from the Rad/Nuc Med Division file."
+9 DO BMES^XPDUTL(.RATXT)
+10 FOR
SET RAD0=$ORDER(^RA(79,RAD0))
if RAD0'>0
QUIT
Begin DoDot:1
+11 SET RAREQ=$PIECE($GET(^RA(79,RAD0,.1)),"^",5)
+12 if RAREQ]""
DO ENKILL^RAXREF(RADD,RAFLD,RAREQ,.RAD0)
+13 if RAREQ]""
SET $PIECE(^RA(79,RAD0,.1),"^",5)=""
+14 QUIT
End DoDot:1
+15 ; delete field from DD!
SET DIK="^DD(79,"
SET DA(1)=RADD
SET DA=RAFLD
DO ^DIK
+16 QUIT
EN4 ; Delete the following fields from the Rad/Nuc Med Division
+1 ; data dictionary: Last DFN Converted (75.1), Conversion Start
+2 ; Time (75.1), Conversion Stop Time (75.1), Last DFN Converted
+3 ; (70), Conversion Start Time (70) & Conversion Stop Time (70).
+4 ; All data associated with these fields will be deleted.
+5 NEW RADD,RAXIST
SET RADD=79
SET RAXIST=0
+6 FOR RAFLD=2300.1:.1:2300.6
if $DATA(^DD(RADD,RAFLD,0))
SET RAXIST=1
+7 ; fields have already been deleted!
if 'RAXIST
QUIT
+8 NEW %,DA,DIC,DIK,RAD0,RADATA,RAFILE,RAFLD,RAFLDTXT,RATXT,X,Y
SET RAD0=0
+9 SET RAFILE=$SELECT($DATA(^DIC(RADD,0))#2:$PIECE(^(0),"^"),1:"Unknown")
+10 FOR
SET RAD0=$ORDER(^RA(RADD,RAD0))
if RAD0'>0
QUIT
Begin DoDot:1
+11 FOR RAFLD=2300.1:.1:2300.6
Begin DoDot:2
+12 SET RAFLDTXT=$SELECT($DATA(^DD(RADD,RAFLD,0))#2:$PIECE(^(0),"^"),1:"Unknown")
+13 ; unidentified field
if RAFLDTXT="Unknown"
QUIT
+14 SET RADATA=$PIECE($GET(^RA(RADD,RAD0,"PATCH23")),"^",$PIECE(RAFLD,".",2))
+15 if RADATA]""
DO ENKILL^RAXREF(RADD,RAFLD,RADATA,.RAD0)
+16 if RADATA]""
SET $PIECE(^RA(RADD,RAD0,"PATCH23"),"^",$PIECE(RAFLD,".",2))=""
+17 SET RATXT(1)=" "
SET RATXT(2)="Deleting obsolete "_RAFLDTXT_" field from"
+18 SET RATXT(3)=RAFILE_" data dictionary."
+19 SET RATXT(4)="Deleting "_RAFLDTXT_" data from the"
+20 SET RATXT(5)=RAFILE_" file. Division: "_$$GET1^DIQ(4,RAD0_",",.01)
+21 DO BMES^XPDUTL(.RATXT)
+22 ; delete field!
SET DIK="^DD("_RADD_","
SET DA(1)=RADD
SET DA=RAFLD
DO ^DIK
+23 QUIT
End DoDot:2
+24 ; kill off data node
KILL %,DA,DIC,DIK,X,Y
KILL ^RA(RADD,RAD0,"PATCH23")
+25 QUIT
End DoDot:1
+26 QUIT
EN5 ; Change the name of 'Radiology Location' in the Label Print Fields
+1 ; file (78.7) to 'Imaging Location'.
+2 ; 'Imaging Location' exists
if +$ORDER(^RA(78.7,"B","IMAGING LOCATION",0))
QUIT
+3 NEW RADLOC,RAFDA,RATXT
SET RATXT(1)=""
+4 SET RATXT(2)="Changing name of Label Print Field (file: 78.7)"
+5 SET RATXT(3)="from: 'RADIOLOGY LOCATION' to 'IMAGING LOCATION'"
+6 SET RADLOC=+$ORDER(^RA(78.7,"B","RADIOLOGY LOCATION",0))
+7 if 'RADLOC
QUIT
DO MES^XPDUTL(.RATXT)
+8 SET RAFDA(78.7,RADLOC_",",.01)="IMAGING LOCATION"
+9 DO FILE^DIE("","RAFDA","")
+10 QUIT
EN7 ; Un-compile the 'RA STATUS CHANGE' & 'RA EXAM EDIT' input templates
+1 ; on the Rad/Nuc Med Patient file.
+2 ; Variable Definition:
+3 ; RAEXED -> ien of the RA EXAM EDIT template
+4 ; RASTCH -> ien of the RA STATUS CHANGE template
+5 ; RATXT -> array which contains the message displayed to the user
+6 ;
+7 NEW RAEXED,RASTCH,RATXT
+8 SET RASTCH=$$FIND1^DIC(.402,"","X","RA STATUS CHANGE")
+9 ; the input template exists
IF RASTCH
Begin DoDot:1
+10 DO TMPMSG("RA STATUS CHANGE")
DO MES^XPDUTL(.RATXT)
DO UNC^DIEZ(RASTCH,"D")
+11 QUIT
End DoDot:1
+12 SET RAEXED=$$FIND1^DIC(.402,"","X","RA EXAM EDIT")
+13 ; the input template exists
IF RAEXED
KILL RATXT
Begin DoDot:1
+14 DO TMPMSG("RA EXAM EDIT")
DO MES^XPDUTL(.RATXT)
DO UNC^DIEZ(RAEXED,"D")
+15 QUIT
End DoDot:1
+16 QUIT
TMPMSG(X) ; Build the text array for each specific compiled input
+1 ; template.
+2 ; Input: X-the name of the input template
+3 SET RATXT(1)=""
+4 SET RATXT(2)="Un-compiling the `"_X_"' input template on the"
+5 SET RATXT(3)="Rad/Nuc Med Patient file. All the compiled templates"
+6 SET RATXT(4)="associated with `"_X_"' will be deleted."
+7 QUIT
