- ECX3P71 ; BPFO/JRC - Post Utility for DSS Extracts ; 11/24/04 9:28am
- ;;3.0;DSS EXTRACTS;**71**;Dec 22, 1997
- EN ;Main entry point
- ;Change menu option locks
- N MENU,PTR
- S (MENU,PTR)=""
- F MENU="ECXMGR","ECX MAINTENANCE","ECX TRANSMISSION","ECXSCLOAD","ECXSCEDIT","ECXSCAPPROV","ECX IV DIV EDIT","ECXLABRS","ECX LAB RESULTS TRANS EDIT" D
- .K ECXMSG
- .S ECXMSG(1)=" "
- .S ECXMSG(2)=$S(MENU="ECX MAINTENANCE":"** Removing ",MENU="ECX TRANSMISSION":"** Removing ",MENU="ECXMGR":"** Removing ",1:"** Adding ")_"ECXMGR lock for "_MENU_" menu **"
- .D MES^XPDUTL(.ECXMSG)
- .;Order thru option file and find menu and retrieve IEN
- .S PTR="",PTR=$O(^DIC(19,"B",MENU,PTR))
- .I 'PTR D BMES^XPDUTL("** "_MENU_" item not found, not updated **") Q
- .S $P(^DIC(19,PTR,0),U,6)=$S(MENU="ECX MAINTENANCE":"",MENU="ECX TRANSMISSION":"",MENU="ECXMGR":"",1:"ECXMGR")
- D BMES^XPDUTL("** Menu locks update completed **")
- ;
- ;Remove ECX DSSDEPT DECODE menu
- ;
- ;Init variables
- N MENU,SMENU,PTR,DA,DIK
- S (MENU,SMENU,PTR)=""
- S ECXMSG(1)=" "
- S ECXMSG(2)="** Looking for ECX DSSDEPT DECODE menu under ECX DSSDEPT MGMT **"
- S ECXMSG(3)=" If found, the submenu item will be deleted "
- D MES^XPDUTL(.ECXMSG)
- ;Order thru option file and find ECX DSSDEPT MGMT and retrieve IEN
- S MENU=$O(^DIC(19,"B","ECX DSSDEPT MGMT",MENU))
- I 'MENU D BMES^XPDUTL("** ECX DSSDEPT MGMT item not found **") Q
- ;Order thru option file and find ECX DSSDEPT DECODE and retrieve IEN
- S SMENU=$O(^DIC(19,"B","ECX DSSDEPT DECODE",SMENU))
- I 'SMENU D BMES^XPDUTL("** ECX DSSDEPT DECODE menu item not found **") Q
- ;Order thru ECX DSSDEPT MGMT menu subfile check for ECX DSSDEPT DECODE
- S PTR=($O(^DIC(19,MENU,10,"B",SMENU,PTR)))
- I 'PTR D BMES^XPDUTL("** ECX DSSDEPT DECODE was not found as a submenu, nothing deleted **") Q
- D BMES^XPDUTL("** ECX DSSDEPT DECODE menu found under ECX DSSDEPT MGMT **")
- S DA(1)=MENU,DIK="^DIC(19,"_DA(1)_","_10_",",DA=PTR
- D ^DIK
- N ECXMSG
- S ECXMSG(1)=" "
- S ECXMSG(2)="*** ECX DSSDEPT DECODE menu deleted from ECX DSSDEPT MGMT menu ***"
- D MES^XPDUTL(.ECXMSG)
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HECX3P71 2098 printed Jan 18, 2025@02:51:59 Page 2
- ECX3P71 ; BPFO/JRC - Post Utility for DSS Extracts ; 11/24/04 9:28am
- +1 ;;3.0;DSS EXTRACTS;**71**;Dec 22, 1997
- EN ;Main entry point
- +1 ;Change menu option locks
- +2 NEW MENU,PTR
- +3 SET (MENU,PTR)=""
- +4 FOR MENU="ECXMGR","ECX MAINTENANCE","ECX TRANSMISSION","ECXSCLOAD","ECXSCEDIT","ECXSCAPPROV","ECX IV DIV EDIT","ECXLABRS","ECX LAB RESULTS TRANS EDIT"
- Begin DoDot:1
- +5 KILL ECXMSG
- +6 SET ECXMSG(1)=" "
- +7 SET ECXMSG(2)=$SELECT(MENU="ECX MAINTENANCE":"** Removing ",MENU="ECX TRANSMISSION":"** Removing ",MENU="ECXMGR":"** Removing ",1:"** Adding ")_"ECXMGR lock for "_MENU_" menu **"
- +8 DO MES^XPDUTL(.ECXMSG)
- +9 ;Order thru option file and find menu and retrieve IEN
- +10 SET PTR=""
- SET PTR=$ORDER(^DIC(19,"B",MENU,PTR))
- +11 IF 'PTR
- DO BMES^XPDUTL("** "_MENU_" item not found, not updated **")
- QUIT
- +12 SET $PIECE(^DIC(19,PTR,0),U,6)=$SELECT(MENU="ECX MAINTENANCE":"",MENU="ECX TRANSMISSION":"",MENU="ECXMGR":"",1:"ECXMGR")
- End DoDot:1
- +13 DO BMES^XPDUTL("** Menu locks update completed **")
- +14 ;
- +15 ;Remove ECX DSSDEPT DECODE menu
- +16 ;
- +17 ;Init variables
- +18 NEW MENU,SMENU,PTR,DA,DIK
- +19 SET (MENU,SMENU,PTR)=""
- +20 SET ECXMSG(1)=" "
- +21 SET ECXMSG(2)="** Looking for ECX DSSDEPT DECODE menu under ECX DSSDEPT MGMT **"
- +22 SET ECXMSG(3)=" If found, the submenu item will be deleted "
- +23 DO MES^XPDUTL(.ECXMSG)
- +24 ;Order thru option file and find ECX DSSDEPT MGMT and retrieve IEN
- +25 SET MENU=$ORDER(^DIC(19,"B","ECX DSSDEPT MGMT",MENU))
- +26 IF 'MENU
- DO BMES^XPDUTL("** ECX DSSDEPT MGMT item not found **")
- QUIT
- +27 ;Order thru option file and find ECX DSSDEPT DECODE and retrieve IEN
- +28 SET SMENU=$ORDER(^DIC(19,"B","ECX DSSDEPT DECODE",SMENU))
- +29 IF 'SMENU
- DO BMES^XPDUTL("** ECX DSSDEPT DECODE menu item not found **")
- QUIT
- +30 ;Order thru ECX DSSDEPT MGMT menu subfile check for ECX DSSDEPT DECODE
- +31 SET PTR=($ORDER(^DIC(19,MENU,10,"B",SMENU,PTR)))
- +32 IF 'PTR
- DO BMES^XPDUTL("** ECX DSSDEPT DECODE was not found as a submenu, nothing deleted **")
- QUIT
- +33 DO BMES^XPDUTL("** ECX DSSDEPT DECODE menu found under ECX DSSDEPT MGMT **")
- +34 SET DA(1)=MENU
- SET DIK="^DIC(19,"_DA(1)_","_10_","
- SET DA=PTR
- +35 DO ^DIK
- +36 NEW ECXMSG
- +37 SET ECXMSG(1)=" "
- +38 SET ECXMSG(2)="*** ECX DSSDEPT DECODE menu deleted from ECX DSSDEPT MGMT menu ***"
- +39 DO MES^XPDUTL(.ECXMSG)
- +40 QUIT