ECX30P92 ; ALB/JRC - Post Utility for DSS Extracts Patch 92 ; 8/15/06 8:45am
;;3.0;DSS EXTRACTS;**92**;Dec 22, 1997;Build 30
EN ;Main entry point
;Remove Clinic Extract file (#727.803) and all data
N ECXMSG,DIU
K ECXMSG
S ECXMSG(1)=" "
S ECXMSG(2)="** Removing Clinic Extract File (#727.803) and all data **"
D MES^XPDUTL(.ECXMSG)
S DIU=727.803,DIU(0)="DT"
D EN^DIU2
K ECXMSG
S ECXMSG(1)=" "
S ECXMSG(2)="** Clinic Extract File (#727.803) and all data removed **"
;
;Remove dental menus and disable them
;Init variables
N MENU,PTR,SMENU,SPTR,NUM,DA,DIK
F MENU="ECX SOURCE AUDITS","ECX SAS AUDITS" D
.K ECXMSG
.S ECXMSG(1)=" "
.S ECXMSG(2)=$S(MENU="ECX SOURCE AUDITS":"Removing [ECX DEN SOURCE AUDIT] menu",MENU="ECX SAS AUDITS":"Removing [ECX SAS DENTAL] menu",1:"")
.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
.;resolve submenu to remove
.S SMENU=$S(MENU="ECX SOURCE AUDITS":"ECX DEN SOURCE AUDIT",1:"ECX SAS DENTAL")
.S SPTR="",SPTR=$O(^DIC(19,"B",SMENU,SPTR))
.I 'SPTR D Q
..D BMES^XPDUTL("** "_SMENU_" item not found, not updated **")
.;Disable menu option
.D OUT^XPDMENU(SMENU,"MENU OPTION NO LONGER USED")
.D BMES^XPDUTL(SMENU_" ** Menu option disabled **")
.;Remove menu option
.S NUM=0,NUM=$O(^DIC(19,PTR,10,"B",SPTR,NUM))
.I 'NUM D Q
..D BMES^XPDUTL("** "_SMENU_" item not found, not updated **")
.S DIK="^DIC(19,"_PTR_",10,"
.S DA(1)=PTR,DA=NUM
.D ^DIK
D BMES^XPDUTL("** Menu updates completed **")
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HECX30P92 1653 printed Oct 16, 2024@17:50:33 Page 2
ECX30P92 ; ALB/JRC - Post Utility for DSS Extracts Patch 92 ; 8/15/06 8:45am
+1 ;;3.0;DSS EXTRACTS;**92**;Dec 22, 1997;Build 30
EN ;Main entry point
+1 ;Remove Clinic Extract file (#727.803) and all data
+2 NEW ECXMSG,DIU
+3 KILL ECXMSG
+4 SET ECXMSG(1)=" "
+5 SET ECXMSG(2)="** Removing Clinic Extract File (#727.803) and all data **"
+6 DO MES^XPDUTL(.ECXMSG)
+7 SET DIU=727.803
SET DIU(0)="DT"
+8 DO EN^DIU2
+9 KILL ECXMSG
+10 SET ECXMSG(1)=" "
+11 SET ECXMSG(2)="** Clinic Extract File (#727.803) and all data removed **"
+12 ;
+13 ;Remove dental menus and disable them
+14 ;Init variables
+15 NEW MENU,PTR,SMENU,SPTR,NUM,DA,DIK
+16 FOR MENU="ECX SOURCE AUDITS","ECX SAS AUDITS"
Begin DoDot:1
+17 KILL ECXMSG
+18 SET ECXMSG(1)=" "
+19 SET ECXMSG(2)=$SELECT(MENU="ECX SOURCE AUDITS":"Removing [ECX DEN SOURCE AUDIT] menu",MENU="ECX SAS AUDITS":"Removing [ECX SAS DENTAL] menu",1:"")
+20 DO MES^XPDUTL(.ECXMSG)
+21 ;Order thru option file and find menu and retrieve IEN
+22 SET PTR=""
SET PTR=$ORDER(^DIC(19,"B",MENU,PTR))
+23 IF 'PTR
DO BMES^XPDUTL("** "_MENU_" item not found, not updated **")
QUIT
+24 ;resolve submenu to remove
+25 SET SMENU=$SELECT(MENU="ECX SOURCE AUDITS":"ECX DEN SOURCE AUDIT",1:"ECX SAS DENTAL")
+26 SET SPTR=""
SET SPTR=$ORDER(^DIC(19,"B",SMENU,SPTR))
+27 IF 'SPTR
Begin DoDot:2
+28 DO BMES^XPDUTL("** "_SMENU_" item not found, not updated **")
End DoDot:2
QUIT
+29 ;Disable menu option
+30 DO OUT^XPDMENU(SMENU,"MENU OPTION NO LONGER USED")
+31 DO BMES^XPDUTL(SMENU_" ** Menu option disabled **")
+32 ;Remove menu option
+33 SET NUM=0
SET NUM=$ORDER(^DIC(19,PTR,10,"B",SPTR,NUM))
+34 IF 'NUM
Begin DoDot:2
+35 DO BMES^XPDUTL("** "_SMENU_" item not found, not updated **")
End DoDot:2
QUIT
+36 SET DIK="^DIC(19,"_PTR_",10,"
+37 SET DA(1)=PTR
SET DA=NUM
+38 DO ^DIK
End DoDot:1
+39 DO BMES^XPDUTL("** Menu updates completed **")
+40 QUIT
+41 ;