- 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 Feb 19, 2025@00:02:35 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