RAIPRE2.m

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 ---RAIPRE2   5530     printed  Mar 13, 2025@21:40:42                                                                                                                                                                                                     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