source: WorldVistAEHR/trunk/r/DSS_EXTRACTS-ECX/ECX3P71.m@ 1005

Last change on this file since 1005 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 2.0 KB
Line 
1ECX3P71 ; BPFO/JRC - Post Utility for DSS Extracts ; 11/24/04 9:28am
2 ;;3.0;DSS EXTRACTS;**71**;Dec 22, 1997
3EN ;Main entry point
4 ;Change menu option locks
5 N MENU,PTR
6 S (MENU,PTR)=""
7 F MENU="ECXMGR","ECX MAINTENANCE","ECX TRANSMISSION","ECXSCLOAD","ECXSCEDIT","ECXSCAPPROV","ECX IV DIV EDIT","ECXLABRS","ECX LAB RESULTS TRANS EDIT" D
8 .K ECXMSG
9 .S ECXMSG(1)=" "
10 .S ECXMSG(2)=$S(MENU="ECX MAINTENANCE":"** Removing ",MENU="ECX TRANSMISSION":"** Removing ",MENU="ECXMGR":"** Removing ",1:"** Adding ")_"ECXMGR lock for "_MENU_" menu **"
11 .D MES^XPDUTL(.ECXMSG)
12 .;Order thru option file and find menu and retrieve IEN
13 .S PTR="",PTR=$O(^DIC(19,"B",MENU,PTR))
14 .I 'PTR D BMES^XPDUTL("** "_MENU_" item not found, not updated **") Q
15 .S $P(^DIC(19,PTR,0),U,6)=$S(MENU="ECX MAINTENANCE":"",MENU="ECX TRANSMISSION":"",MENU="ECXMGR":"",1:"ECXMGR")
16 D BMES^XPDUTL("** Menu locks update completed **")
17 ;
18 ;Remove ECX DSSDEPT DECODE menu
19 ;
20 ;Init variables
21 N MENU,SMENU,PTR,DA,DIK
22 S (MENU,SMENU,PTR)=""
23 S ECXMSG(1)=" "
24 S ECXMSG(2)="** Looking for ECX DSSDEPT DECODE menu under ECX DSSDEPT MGMT **"
25 S ECXMSG(3)=" If found, the submenu item will be deleted "
26 D MES^XPDUTL(.ECXMSG)
27 ;Order thru option file and find ECX DSSDEPT MGMT and retrieve IEN
28 S MENU=$O(^DIC(19,"B","ECX DSSDEPT MGMT",MENU))
29 I 'MENU D BMES^XPDUTL("** ECX DSSDEPT MGMT item not found **") Q
30 ;Order thru option file and find ECX DSSDEPT DECODE and retrieve IEN
31 S SMENU=$O(^DIC(19,"B","ECX DSSDEPT DECODE",SMENU))
32 I 'SMENU D BMES^XPDUTL("** ECX DSSDEPT DECODE menu item not found **") Q
33 ;Order thru ECX DSSDEPT MGMT menu subfile check for ECX DSSDEPT DECODE
34 S PTR=($O(^DIC(19,MENU,10,"B",SMENU,PTR)))
35 I 'PTR D BMES^XPDUTL("** ECX DSSDEPT DECODE was not found as a submenu, nothing deleted **") Q
36 D BMES^XPDUTL("** ECX DSSDEPT DECODE menu found under ECX DSSDEPT MGMT **")
37 S DA(1)=MENU,DIK="^DIC(19,"_DA(1)_","_10_",",DA=PTR
38 D ^DIK
39 N ECXMSG
40 S ECXMSG(1)=" "
41 S ECXMSG(2)="*** ECX DSSDEPT DECODE menu deleted from ECX DSSDEPT MGMT menu ***"
42 D MES^XPDUTL(.ECXMSG)
43 Q
Note: See TracBrowser for help on using the repository browser.