| [613] | 1 | ECX3P71 ; BPFO/JRC - Post Utility for DSS Extracts ; 11/24/04 9:28am
|
|---|
| 2 | ;;3.0;DSS EXTRACTS;**71**;Dec 22, 1997
|
|---|
| 3 | EN ;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
|
|---|
