EC2P100 ;ALB/MRY - PATCH EC*2.0*100 Post-Init Rtn ;01/07/2009
;;2.0; EVENT CAPTURE ;**100**;8 May 96;Build 21
;
ENV ;environment check
S XPDABORT=""
D PROGCHK(.XPDABORT) ;checks programmer variables
I XPDABORT="" K XPDABORT
Q
;
PROGCHK(XPDABORT) ;checks for necessary programmer variables
;
I '$G(DUZ)!($G(DUZ(0))'="@")!('$G(DT))!($G(U)'="^") DO
. D BMES^XPDUTL("******")
. D MES^XPDUTL("Your programming variables are not set up properly.")
. D MES^XPDUTL("Installation aborted.")
. D MES^XPDUTL("******")
. S XPDABORT=2
Q
;
POST ;
OPTION ;move [ec night] into [ec pce feed], if exists. Then, disable.
D RENOPT("EC NIGHT","EC PCE FEED")
F ECMENU="EC NIGHT","EC PCE FEED" D DISOPT(ECMENU)
;
;add users of the ECXMGR security key to ECMGR mailgroup.
D MAILGP
;add Last Used, Table Printer, & Visits objects
D VOBS
Q
;
RENOPT(ECOLD,ECNEW) ;rename option
;
; Input:
; ECOLD - original option name
; ECNEW - new option name
;
;
I +$$LKOPT^XPDMENU(ECNEW)>0 Q ;quit if new exists
I '+$$LKOPT^XPDMENU(ECOLD) Q ;quit if old doesn't exit
I $G(ECOLD)'="",$G(ECNEW)'="",+$$LKOPT^XPDMENU(ECOLD)>0 D
. D RENAME^XPDMENU(ECOLD,ECNEW)
Q
DISOPT(MENU) ;Disable Options
I '+$$LKOPT^XPDMENU(MENU) Q
N ECMSG
K ECMSG
S ECMSG(1)=" "
S ECMSG(2)=">>> Disabling ["_MENU_"] option"
D MES^XPDUTL(.ECXMSG)
;Disable menu option
D OUT^XPDMENU(MENU,"MENU OPTION NO LONGER USED")
D BMES^XPDUTL(" "_MENU_" ** Menu option disabled **")
Q
MAILGP ;add users of ECXMGR key to ECMGR mailgroup
D BMES^XPDUTL(">>> Adding users with the ECXMGR key to ECMGR Mailgroup...")
N DIC,X,DA,ECDUZ
S DIC="^XMB(3.8,",DIC(0)="X",X="ECMGR" D ^DIC
S DA(1)=+Y,DIC=DIC_DA(1)_",1,",DIC("P")=$P(^DD(3.8,2,0),"^",2),DIC(0)="L"
S ECDUZ=0 F S ECDUZ=$O(^XUSEC("ECXMGR",ECDUZ)) Q:'ECDUZ D
. S X=$$GET1^DIQ(200,ECDUZ,.01) D ^DIC
. I +$P(Y,"^",3) D MES^XPDUTL(" "_X_" added.")
Q
;;
;;
VOBS ;;Install utility objects
D BMES^XPDUTL("Installing Event Capture Object Factory Parameters")
;;
D EN^XPAR("PKG","ECOB CONSTRUCTOR","EC OBU UTILITY","CREATE.ECOBU(NAME)")
D EN^XPAR("PKG","ECOB DESTRUCTOR","EC OBU UTILITY","DESTROY.ECOBU(HANDLE)")
D EN^XPAR("PKG","ECOB METHOD","EC OBU UTILITY","METHOD.ECOBU(.RESULT,ARGUMENT)")
D MES^XPDUTL("EC OBU UTILITY... published")
;;
D EN^XPAR("PKG","ECOB CONSTRUCTOR","EC OBU UTILITY LIST","CREATE.ECOBUL(NAME)")
D EN^XPAR("PKG","ECOB DESTRUCTOR","EC OBU UTILITY LIST","DESTROY.ECOBUL(HANDLE)")
D EN^XPAR("PKG","ECOB METHOD","EC OBU UTILITY LIST","METHOD.ECOBUL(.RESULT,ARGUMENT)")
D MES^XPDUTL("EC OBU UTILITY LIST... published")
;;
D EN^XPAR("PKG","ECOB CONSTRUCTOR","EC OBU LAST USED","CREATE.ECOB31(NAME)")
D EN^XPAR("PKG","ECOB DESTRUCTOR","EC OBU LAST USED","DESTROY.ECOB31(HANDLE)")
D EN^XPAR("PKG","ECOB METHOD","EC OBU LAST USED","METHOD.ECOB31(.RESULT,ARGUMENT)")
D MES^XPDUTL("EC OBU LAST USED... published")
;;
D EN^XPAR("PKG","ECOB CONSTRUCTOR","EC DSS UNIT TABLE","CREATE.ECOB41(NAME)")
D EN^XPAR("PKG","ECOB DESTRUCTOR","EC DSS UNIT TABLE","DESTROY.ECOB41(HANDLE)")
D EN^XPAR("PKG","ECOB METHOD","EC DSS UNIT TABLE","METHOD.ECOB41(.RESULT,ARGUMENT)")
D MES^XPDUTL("EC DSS UNIT TABLE... published")
;;
D EN^XPAR("PKG","ECOB CONSTRUCTOR","EC VISIT","CREATE.ECOBVST(NAME)")
D EN^XPAR("PKG","ECOB DESTRUCTOR","EC VISIT","DESTROY.ECOBVST(HANDLE)")
D EN^XPAR("PKG","ECOB METHOD","EC VISIT","METHOD.ECOBVST(.RESULT,ARGUMENT)")
D MES^XPDUTL("EC VISIT... published")
;;
D EN^XPAR("PKG","ECOB CONSTRUCTOR","EC VISITS","CREATE.ECOBVSTS(NAME)")
D EN^XPAR("PKG","ECOB DESTRUCTOR","EC VISITS","DESTROY.ECOBVSTS(HANDLE)")
D EN^XPAR("PKG","ECOB METHOD","EC VISITS","METHOD.ECOBVSTS(.RESULT,ARGUMENT)")
D MES^XPDUTL("EC VISITS... published")
;;
Q
;;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HEC2P100 3823 printed Dec 13, 2024@01:54:41 Page 2
EC2P100 ;ALB/MRY - PATCH EC*2.0*100 Post-Init Rtn ;01/07/2009
+1 ;;2.0; EVENT CAPTURE ;**100**;8 May 96;Build 21
+2 ;
ENV ;environment check
+1 SET XPDABORT=""
+2 ;checks programmer variables
DO PROGCHK(.XPDABORT)
+3 IF XPDABORT=""
KILL XPDABORT
+4 QUIT
+5 ;
PROGCHK(XPDABORT) ;checks for necessary programmer variables
+1 ;
+2 IF '$GET(DUZ)!($GET(DUZ(0))'="@")!('$GET(DT))!($GET(U)'="^")
Begin DoDot:1
+3 DO BMES^XPDUTL("******")
+4 DO MES^XPDUTL("Your programming variables are not set up properly.")
+5 DO MES^XPDUTL("Installation aborted.")
+6 DO MES^XPDUTL("******")
+7 SET XPDABORT=2
End DoDot:1
+8 QUIT
+9 ;
POST ;
OPTION ;move [ec night] into [ec pce feed], if exists. Then, disable.
+1 DO RENOPT("EC NIGHT","EC PCE FEED")
+2 FOR ECMENU="EC NIGHT","EC PCE FEED"
DO DISOPT(ECMENU)
+3 ;
+4 ;add users of the ECXMGR security key to ECMGR mailgroup.
+5 DO MAILGP
+6 ;add Last Used, Table Printer, & Visits objects
+7 DO VOBS
+8 QUIT
+9 ;
RENOPT(ECOLD,ECNEW) ;rename option
+1 ;
+2 ; Input:
+3 ; ECOLD - original option name
+4 ; ECNEW - new option name
+5 ;
+6 ;
+7 ;quit if new exists
IF +$$LKOPT^XPDMENU(ECNEW)>0
QUIT
+8 ;quit if old doesn't exit
IF '+$$LKOPT^XPDMENU(ECOLD)
QUIT
+9 IF $GET(ECOLD)'=""
IF $GET(ECNEW)'=""
IF +$$LKOPT^XPDMENU(ECOLD)>0
Begin DoDot:1
+10 DO RENAME^XPDMENU(ECOLD,ECNEW)
End DoDot:1
+11 QUIT
DISOPT(MENU) ;Disable Options
+1 IF '+$$LKOPT^XPDMENU(MENU)
QUIT
+2 NEW ECMSG
+3 KILL ECMSG
+4 SET ECMSG(1)=" "
+5 SET ECMSG(2)=">>> Disabling ["_MENU_"] option"
+6 DO MES^XPDUTL(.ECXMSG)
+7 ;Disable menu option
+8 DO OUT^XPDMENU(MENU,"MENU OPTION NO LONGER USED")
+9 DO BMES^XPDUTL(" "_MENU_" ** Menu option disabled **")
+10 QUIT
MAILGP ;add users of ECXMGR key to ECMGR mailgroup
+1 DO BMES^XPDUTL(">>> Adding users with the ECXMGR key to ECMGR Mailgroup...")
+2 NEW DIC,X,DA,ECDUZ
+3 SET DIC="^XMB(3.8,"
SET DIC(0)="X"
SET X="ECMGR"
DO ^DIC
+4 SET DA(1)=+Y
SET DIC=DIC_DA(1)_",1,"
SET DIC("P")=$PIECE(^DD(3.8,2,0),"^",2)
SET DIC(0)="L"
+5 SET ECDUZ=0
FOR
SET ECDUZ=$ORDER(^XUSEC("ECXMGR",ECDUZ))
if 'ECDUZ
QUIT
Begin DoDot:1
+6 SET X=$$GET1^DIQ(200,ECDUZ,.01)
DO ^DIC
+7 IF +$PIECE(Y,"^",3)
DO MES^XPDUTL(" "_X_" added.")
End DoDot:1
+8 QUIT
+9 ;;
+10 ;;
VOBS ;;Install utility objects
+1 DO BMES^XPDUTL("Installing Event Capture Object Factory Parameters")
+2 ;;
+3 DO EN^XPAR("PKG","ECOB CONSTRUCTOR","EC OBU UTILITY","CREATE.ECOBU(NAME)")
+4 DO EN^XPAR("PKG","ECOB DESTRUCTOR","EC OBU UTILITY","DESTROY.ECOBU(HANDLE)")
+5 DO EN^XPAR("PKG","ECOB METHOD","EC OBU UTILITY","METHOD.ECOBU(.RESULT,ARGUMENT)")
+6 DO MES^XPDUTL("EC OBU UTILITY... published")
+7 ;;
+8 DO EN^XPAR("PKG","ECOB CONSTRUCTOR","EC OBU UTILITY LIST","CREATE.ECOBUL(NAME)")
+9 DO EN^XPAR("PKG","ECOB DESTRUCTOR","EC OBU UTILITY LIST","DESTROY.ECOBUL(HANDLE)")
+10 DO EN^XPAR("PKG","ECOB METHOD","EC OBU UTILITY LIST","METHOD.ECOBUL(.RESULT,ARGUMENT)")
+11 DO MES^XPDUTL("EC OBU UTILITY LIST... published")
+12 ;;
+13 DO EN^XPAR("PKG","ECOB CONSTRUCTOR","EC OBU LAST USED","CREATE.ECOB31(NAME)")
+14 DO EN^XPAR("PKG","ECOB DESTRUCTOR","EC OBU LAST USED","DESTROY.ECOB31(HANDLE)")
+15 DO EN^XPAR("PKG","ECOB METHOD","EC OBU LAST USED","METHOD.ECOB31(.RESULT,ARGUMENT)")
+16 DO MES^XPDUTL("EC OBU LAST USED... published")
+17 ;;
+18 DO EN^XPAR("PKG","ECOB CONSTRUCTOR","EC DSS UNIT TABLE","CREATE.ECOB41(NAME)")
+19 DO EN^XPAR("PKG","ECOB DESTRUCTOR","EC DSS UNIT TABLE","DESTROY.ECOB41(HANDLE)")
+20 DO EN^XPAR("PKG","ECOB METHOD","EC DSS UNIT TABLE","METHOD.ECOB41(.RESULT,ARGUMENT)")
+21 DO MES^XPDUTL("EC DSS UNIT TABLE... published")
+22 ;;
+23 DO EN^XPAR("PKG","ECOB CONSTRUCTOR","EC VISIT","CREATE.ECOBVST(NAME)")
+24 DO EN^XPAR("PKG","ECOB DESTRUCTOR","EC VISIT","DESTROY.ECOBVST(HANDLE)")
+25 DO EN^XPAR("PKG","ECOB METHOD","EC VISIT","METHOD.ECOBVST(.RESULT,ARGUMENT)")
+26 DO MES^XPDUTL("EC VISIT... published")
+27 ;;
+28 DO EN^XPAR("PKG","ECOB CONSTRUCTOR","EC VISITS","CREATE.ECOBVSTS(NAME)")
+29 DO EN^XPAR("PKG","ECOB DESTRUCTOR","EC VISITS","DESTROY.ECOBVSTS(HANDLE)")
+30 DO EN^XPAR("PKG","ECOB METHOD","EC VISITS","METHOD.ECOBVSTS(.RESULT,ARGUMENT)")
+31 DO MES^XPDUTL("EC VISITS... published")
+32 ;;
+33 QUIT
+34 ;;
