source: FOIAVistA/trunk/r/DSS_EXTRACTS-ECX/ECX30P92.m@ 812

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

initial load of FOIAVistA 6/30/08 version

File size: 1.6 KB
Line 
1ECX30P92 ; ALB/JRC - Post Utility for DSS Extracts Patch 92 ; 8/15/06 8:45am
2 ;;3.0;DSS EXTRACTS;**92**;Dec 22, 1997;Build 30
3EN ;Main entry point
4 ;Remove Clinic Extract file (#727.803) and all data
5 N ECXMSG,DIU
6 K ECXMSG
7 S ECXMSG(1)=" "
8 S ECXMSG(2)="** Removing Clinic Extract File (#727.803) and all data **"
9 D MES^XPDUTL(.ECXMSG)
10 S DIU=727.803,DIU(0)="DT"
11 D EN^DIU2
12 K ECXMSG
13 S ECXMSG(1)=" "
14 S ECXMSG(2)="** Clinic Extract File (#727.803) and all data removed **"
15 ;
16 ;Remove dental menus and disable them
17 ;Init variables
18 N MENU,PTR,SMENU,SPTR,NUM,DA,DIK
19 F MENU="ECX SOURCE AUDITS","ECX SAS AUDITS" D
20 .K ECXMSG
21 .S ECXMSG(1)=" "
22 .S ECXMSG(2)=$S(MENU="ECX SOURCE AUDITS":"Removing [ECX DEN SOURCE AUDIT] menu",MENU="ECX SAS AUDITS":"Removing [ECX SAS DENTAL] menu",1:"")
23 .D MES^XPDUTL(.ECXMSG)
24 .;Order thru option file and find menu and retrieve IEN
25 .S PTR="",PTR=$O(^DIC(19,"B",MENU,PTR))
26 .I 'PTR D BMES^XPDUTL("** "_MENU_" item not found, not updated **") Q
27 .;resolve submenu to remove
28 .S SMENU=$S(MENU="ECX SOURCE AUDITS":"ECX DEN SOURCE AUDIT",1:"ECX SAS DENTAL")
29 .S SPTR="",SPTR=$O(^DIC(19,"B",SMENU,SPTR))
30 .I 'SPTR D Q
31 ..D BMES^XPDUTL("** "_SMENU_" item not found, not updated **")
32 .;Disable menu option
33 .D OUT^XPDMENU(SMENU,"MENU OPTION NO LONGER USED")
34 .D BMES^XPDUTL(SMENU_" ** Menu option disabled **")
35 .;Remove menu option
36 .S NUM=0,NUM=$O(^DIC(19,PTR,10,"B",SPTR,NUM))
37 .I 'NUM D Q
38 ..D BMES^XPDUTL("** "_SMENU_" item not found, not updated **")
39 .S DIK="^DIC(19,"_PTR_",10,"
40 .S DA(1)=PTR,DA=NUM
41 .D ^DIK
42 D BMES^XPDUTL("** Menu updates completed **")
43 Q
44 ;
Note: See TracBrowser for help on using the repository browser.