RAIPR179 ;WOIFO/KLM-postinit 179 ; Apr 16, 2021@09:57:22
;;5.0;Radiology/Nuclear Medicine;**179**;Mar 16, 1998;Build 4
;
;Routine File IA Type
;----------------------------------------------
;OUT^XPDMENU() 1157 (S)
;BMES^XPDUTL 10141 (S)
;$$DELETE^XPDMENU() 1157 (S)
;DELIX^DDMOD() 2916 (S)
;$$LKUP^XPDKEY() 1367 (S)
;$$RENAME^XPDKEY() 1367 (S)
;
EN ;entry point to remove ITEMS from the RA SUPERVISOR menu
; first, get the IEN for the RA SUPERVISOR menu
N RAITEM,RAMENU,RAX,RAS S RAX="RA SUPERVISOR"
S RAMENU=$$FIND1(RAX)
; not found, record incident and exit
I RAMENU=-1 D Q
.D BMES^XPDUTL("Exiting: the 'RA SUPERVISOR' menu was not found!")
.Q
;save off name
S RAMENU=RAX
;
;Find the specific options listed in the FOR loop.
;If found, remove them from the parent menu.
;(Options placed under new sub-menu w/ KIDS)
;
N RAX F RAI=1:1 S RAX=$P($T(OPTS+RAI),";;",2) Q:RAX="" D
.N RAY S RAY=$$FIND1(RAX)
.I RAY=-1 D BMES^XPDUTL("Option: "_RAX_" was not found!") Q
.; Remove the items from the parent menu
.S RAS=$$DELETE^XPDMENU(RAMENU,RAX)
.;RAS = 1 success; else 0
.S RATXT(1)="'"_RAX_"' was "_$S(RAS=0:"not ",1:"")_"removed as an ITEM"
.S RATXT(2)="under the '"_RAMENU_"' menu."
.D BMES^XPDUTL(.RATXT)
.Q
K RATXT
D SKRENAME
D MENUMNT
Q
;
FIND1(RAX) ;find the option IEN based on the option name
;Input: RAX = option name
;Return: IEN option name; else -1
N RAERR,Y
S Y=$$LKOPT^XPDMENU(RAX)
Q $S(Y="":-1,1:Y)
;
SKRENAME ;Rename security key RA UNVERIFY to RA RPTMGR
N RASK1,RASK2,RAY,RAS,RATXT S RASK1="RA UNVERIFY",RASK2="RA RPTMGR"
S RAY=$$LKUP^XPDKEY(RASK1) I RAY="" S RATXT(1)="Security Key "_RASK1_" not found" D OP Q
;RAS=1 success, 0 failure
S RAS=$$RENAME^XPDKEY(RASK1,RASK2)
S RATXT(1)="Security Key "_RASK1_" was "_$S(RAS=0:"not ",1:"")_"renamed to "_RASK2
OP D BMES^XPDUTL(.RATXT)
Q
N RAM,RAOOO
S RAOOO="Option placed out of order with patch RA*5.0*179"
F RAI=0:1 S RAM=$P($T(2+RAI),";;",2) Q:RAM="" D
.N RAY S RAY=$$FIND1(RAM) I RAY<0 D BMES^XPDUTL("Option: "_RAM_" was not found!") Q
.D OUT^XPDMENU(RAM,RAOOO) D BMES^XPDUTL("Option: "_RAM_" placed out of order")
.Q
Q
OPTS ;menu options to remove from RA SUPERVISOR
;;RA UNVERIFY
;;RA DELETERPT
;;RA RESTORE REPORT
2 ;;RA MAP ONE
;;RA MAP TO MRPF
;;RALOINC ENTER
;;RA MRPF PIN
;;RA SEEDING DONE
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRAIPR179 2645 printed Sep 23, 2025@20:11:53 Page 2
RAIPR179 ;WOIFO/KLM-postinit 179 ; Apr 16, 2021@09:57:22
+1 ;;5.0;Radiology/Nuclear Medicine;**179**;Mar 16, 1998;Build 4
+2 ;
+3 ;Routine File IA Type
+4 ;----------------------------------------------
+5 ;OUT^XPDMENU() 1157 (S)
+6 ;BMES^XPDUTL 10141 (S)
+7 ;$$DELETE^XPDMENU() 1157 (S)
+8 ;DELIX^DDMOD() 2916 (S)
+9 ;$$LKUP^XPDKEY() 1367 (S)
+10 ;$$RENAME^XPDKEY() 1367 (S)
+11 ;
EN ;entry point to remove ITEMS from the RA SUPERVISOR menu
+1 ; first, get the IEN for the RA SUPERVISOR menu
+2 NEW RAITEM,RAMENU,RAX,RAS
SET RAX="RA SUPERVISOR"
+3 SET RAMENU=$$FIND1(RAX)
+4 ; not found, record incident and exit
+5 IF RAMENU=-1
Begin DoDot:1
+6 DO BMES^XPDUTL("Exiting: the 'RA SUPERVISOR' menu was not found!")
+7 QUIT
End DoDot:1
QUIT
+8 ;save off name
+9 SET RAMENU=RAX
+10 ;
+11 ;Find the specific options listed in the FOR loop.
+12 ;If found, remove them from the parent menu.
+13 ;(Options placed under new sub-menu w/ KIDS)
+14 ;
+15 NEW RAX
FOR RAI=1:1
SET RAX=$PIECE($TEXT(OPTS+RAI),";;",2)
if RAX=""
QUIT
Begin DoDot:1
+16 NEW RAY
SET RAY=$$FIND1(RAX)
+17 IF RAY=-1
DO BMES^XPDUTL("Option: "_RAX_" was not found!")
QUIT
+18 ; Remove the items from the parent menu
+19 SET RAS=$$DELETE^XPDMENU(RAMENU,RAX)
+20 ;RAS = 1 success; else 0
+21 SET RATXT(1)="'"_RAX_"' was "_$SELECT(RAS=0:"not ",1:"")_"removed as an ITEM"
+22 SET RATXT(2)="under the '"_RAMENU_"' menu."
+23 DO BMES^XPDUTL(.RATXT)
+24 QUIT
End DoDot:1
+25 KILL RATXT
+26 DO SKRENAME
+27 DO MENUMNT
+28 QUIT
+29 ;
FIND1(RAX) ;find the option IEN based on the option name
+1 ;Input: RAX = option name
+2 ;Return: IEN option name; else -1
+3 NEW RAERR,Y
+4 SET Y=$$LKOPT^XPDMENU(RAX)
+5 QUIT $SELECT(Y="":-1,1:Y)
+6 ;
SKRENAME ;Rename security key RA UNVERIFY to RA RPTMGR
+1 NEW RASK1,RASK2,RAY,RAS,RATXT
SET RASK1="RA UNVERIFY"
SET RASK2="RA RPTMGR"
+2 SET RAY=$$LKUP^XPDKEY(RASK1)
IF RAY=""
SET RATXT(1)="Security Key "_RASK1_" not found"
DO OP
QUIT
+3 ;RAS=1 success, 0 failure
+4 SET RAS=$$RENAME^XPDKEY(RASK1,RASK2)
+5 SET RATXT(1)="Security Key "_RASK1_" was "_$SELECT(RAS=0:"not ",1:"")_"renamed to "_RASK2
OP DO BMES^XPDUTL(.RATXT)
+1 QUIT
+1 NEW RAM,RAOOO
+2 SET RAOOO="Option placed out of order with patch RA*5.0*179"
+3 FOR RAI=0:1
SET RAM=$PIECE($TEXT(2+RAI),";;",2)
if RAM=""
QUIT
Begin DoDot:1
+4 NEW RAY
SET RAY=$$FIND1(RAM)
IF RAY<0
DO BMES^XPDUTL("Option: "_RAM_" was not found!")
QUIT
+5 DO OUT^XPDMENU(RAM,RAOOO)
DO BMES^XPDUTL("Option: "_RAM_" placed out of order")
+6 QUIT
End DoDot:1
+7 QUIT
OPTS ;menu options to remove from RA SUPERVISOR
+1 ;;RA UNVERIFY
+2 ;;RA DELETERPT
+3 ;;RA RESTORE REPORT
2 ;;RA MAP ONE
+1 ;;RA MAP TO MRPF
+2 ;;RALOINC ENTER
+3 ;;RA MRPF PIN
+4 ;;RA SEEDING DONE
