RAIPS198 ;HISC/GJC - post install routine ; Feb 14, 2023@10:26:33
;;5.0;Radiology/Nuclear Medicine;**198**;Mar 16, 1998;Build 1
;
;Routine File IA Type
;-----------------------------------------------------
; DELETE^XPDMENU() 1157 (S)
; OUT^XPDMENU() 1157 (S)
; LKOPT^XPDMENU() 1157 (S)
; OPTION #19 10075 (S)
; OPTION #19 10156 (S)
;
QUIT
;
EN ;start here
;--- Step 1: find the option(s) to be set OOO
N RAPRG,RANPRG,RAPRGIEN,RANPRGIEN
;get record # for each option to be OOO'd
S RAPRG="RA PURGE",RANPRG="RA NOPURGE"
S RAPRGIEN=$$LKOPT^XPDMENU(RAPRG)
S RANPRGIEN=$$LKOPT^XPDMENU(RANPRG)
I RAPRGIEN="",(RAPRGIEN="") D Q
.N RATXT S RATXT(1)="Option 'RA PURGE' was not found."
.S RATXT(2)="Option 'RA NOPURGE' was not found."
.D MES^XPDUTL(.RATXT)
.D BMES^XPDUTL("Exiting the RA*5.0*198 post-init process.")
.Q
;
;--- Step 2: set the option(s) OOO
N RAOOOMSG S RAOOOMSG="RA*5.0*198: Radiology data purge not allowed."
I RAPRGIEN>0 D
.N RATXT D OUT^XPDMENU(RAPRG,RAOOOMSG)
.S RAPRG(2)=$P(^DIC(19,RAPRGIEN,0),U,3)
.S RATXT="Option: '"_RAPRG_"' has "_$S(RAPRG(2)="":"not ",1:"")_"been disabled."
.D BMES^XPDUTL(RATXT)
.Q
;
I RANPRGIEN>0 D
.N RATXT D OUT^XPDMENU(RANPRG,RAOOOMSG)
.S RANPRG(2)=$P(^DIC(19,RANPRGIEN,0),U,3)
.S RATXT="Option: '"_RANPRG_"' has "_$S(RANPRG(2)="":"not ",1:"")_"been disabled."
.D BMES^XPDUTL(RATXT)
.Q
;
;--- Step 3: remove the OOO'd option(s) from parent menus
I RAPRGIEN>0 D ;RA PURGE
.N RAMENU S RAMENU="RA SITEMANAGER"
.I $$LKOPT^XPDMENU(RAMENU)="" D MES^XPDUTL("Warning: '"_RAMENU_"' was not found w/item: '"_RAPRG_"'.") QUIT
.N RAR S RAR=$$DELETE^XPDMENU(RAMENU,RAPRG)
.D:RAR=1 BMES^XPDUTL("Option '"_RAPRG_"' was removed as an item from '"_RAMENU_"'.")
.D:RAR=0 BMES^XPDUTL("Option '"_RAPRG_"' was not removed as an item from '"_RAMENU_"'.")
.Q
I RANPRGIEN>0 D ;RA NOPURGE
.N RAMENU F RAMENU="RA TECHMENU","RA EXAMEDIT","RA RADIOLOGIST" D
..I $$LKOPT^XPDMENU(RAMENU)="" D MES^XPDUTL("Warning: '"_RAMENU_"' was not found w/item: '"_RANPRG_"'.") Q
..N RAR S RAR=$$DELETE^XPDMENU(RAMENU,RANPRG)
..D:RAR=1 BMES^XPDUTL("Option '"_RANPRG_"' was removed as an item from '"_RAMENU_"'.")
..D:RAR=0 BMES^XPDUTL("Option '"_RANPRG_"' was not removed as an item from '"_RAMENU_"'.")
..Q
.Q
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRAIPS198 2507 printed Sep 23, 2025@20:12:21 Page 2
RAIPS198 ;HISC/GJC - post install routine ; Feb 14, 2023@10:26:33
+1 ;;5.0;Radiology/Nuclear Medicine;**198**;Mar 16, 1998;Build 1
+2 ;
+3 ;Routine File IA Type
+4 ;-----------------------------------------------------
+5 ; DELETE^XPDMENU() 1157 (S)
+6 ; OUT^XPDMENU() 1157 (S)
+7 ; LKOPT^XPDMENU() 1157 (S)
+8 ; OPTION #19 10075 (S)
+9 ; OPTION #19 10156 (S)
+10 ;
+11 QUIT
+12 ;
EN ;start here
+1 ;--- Step 1: find the option(s) to be set OOO
+2 NEW RAPRG,RANPRG,RAPRGIEN,RANPRGIEN
+3 ;get record # for each option to be OOO'd
+4 SET RAPRG="RA PURGE"
SET RANPRG="RA NOPURGE"
+5 SET RAPRGIEN=$$LKOPT^XPDMENU(RAPRG)
+6 SET RANPRGIEN=$$LKOPT^XPDMENU(RANPRG)
+7 IF RAPRGIEN=""
IF (RAPRGIEN="")
Begin DoDot:1
+8 NEW RATXT
SET RATXT(1)="Option 'RA PURGE' was not found."
+9 SET RATXT(2)="Option 'RA NOPURGE' was not found."
+10 DO MES^XPDUTL(.RATXT)
+11 DO BMES^XPDUTL("Exiting the RA*5.0*198 post-init process.")
+12 QUIT
End DoDot:1
QUIT
+13 ;
+14 ;--- Step 2: set the option(s) OOO
+15 NEW RAOOOMSG
SET RAOOOMSG="RA*5.0*198: Radiology data purge not allowed."
+16 IF RAPRGIEN>0
Begin DoDot:1
+17 NEW RATXT
DO OUT^XPDMENU(RAPRG,RAOOOMSG)
+18 SET RAPRG(2)=$PIECE(^DIC(19,RAPRGIEN,0),U,3)
+19 SET RATXT="Option: '"_RAPRG_"' has "_$SELECT(RAPRG(2)="":"not ",1:"")_"been disabled."
+20 DO BMES^XPDUTL(RATXT)
+21 QUIT
End DoDot:1
+22 ;
+23 IF RANPRGIEN>0
Begin DoDot:1
+24 NEW RATXT
DO OUT^XPDMENU(RANPRG,RAOOOMSG)
+25 SET RANPRG(2)=$PIECE(^DIC(19,RANPRGIEN,0),U,3)
+26 SET RATXT="Option: '"_RANPRG_"' has "_$SELECT(RANPRG(2)="":"not ",1:"")_"been disabled."
+27 DO BMES^XPDUTL(RATXT)
+28 QUIT
End DoDot:1
+29 ;
+30 ;--- Step 3: remove the OOO'd option(s) from parent menus
+31 ;RA PURGE
IF RAPRGIEN>0
Begin DoDot:1
+32 NEW RAMENU
SET RAMENU="RA SITEMANAGER"
+33 IF $$LKOPT^XPDMENU(RAMENU)=""
DO MES^XPDUTL("Warning: '"_RAMENU_"' was not found w/item: '"_RAPRG_"'.")
QUIT
+34 NEW RAR
SET RAR=$$DELETE^XPDMENU(RAMENU,RAPRG)
+35 if RAR=1
DO BMES^XPDUTL("Option '"_RAPRG_"' was removed as an item from '"_RAMENU_"'.")
+36 if RAR=0
DO BMES^XPDUTL("Option '"_RAPRG_"' was not removed as an item from '"_RAMENU_"'.")
+37 QUIT
End DoDot:1
+38 ;RA NOPURGE
IF RANPRGIEN>0
Begin DoDot:1
+39 NEW RAMENU
FOR RAMENU="RA TECHMENU","RA EXAMEDIT","RA RADIOLOGIST"
Begin DoDot:2
+40 IF $$LKOPT^XPDMENU(RAMENU)=""
DO MES^XPDUTL("Warning: '"_RAMENU_"' was not found w/item: '"_RANPRG_"'.")
QUIT
+41 NEW RAR
SET RAR=$$DELETE^XPDMENU(RAMENU,RANPRG)
+42 if RAR=1
DO BMES^XPDUTL("Option '"_RANPRG_"' was removed as an item from '"_RAMENU_"'.")
+43 if RAR=0
DO BMES^XPDUTL("Option '"_RANPRG_"' was not removed as an item from '"_RAMENU_"'.")
+44 QUIT
End DoDot:2
+45 QUIT
End DoDot:1
+46 QUIT
