162 lines
5.1 KiB
Mathematica
162 lines
5.1 KiB
Mathematica
XB3P9 ;IHS/SET/GTH - XB 3 PATCH 9 ; [ 04/21/2003 9:21 AM ]
|
|
;;4.0;XB;;Jul 20, 2009;Build 2
|
|
;
|
|
; IHS/SET/GTH XB*3*9 10/29/2002
|
|
;
|
|
I '$G(IOM) D HOME^%ZIS
|
|
;
|
|
NEW IORVON,IORVOFF
|
|
S X="IORVON;IORVOFF"
|
|
D ENDR^%ZISS
|
|
;
|
|
I '$G(DUZ) W !,"DUZ UNDEFINED OR 0." D SORRY(2) Q
|
|
;
|
|
I '$L($G(DUZ(0))) W !,"DUZ(0) UNDEFINED OR NULL." D SORRY(2) Q
|
|
;
|
|
S X=$P(^VA(200,DUZ,0),U)
|
|
D BMES^XPDUTL($$CJ^XLFSTR("Hello, "_$P(X,",",2)_" "_$P(X,","),IOM))
|
|
D BMES^XPDUTL($$CJ^XLFSTR("Checking Environment for "_$P($T(+2),";",4)_" V "_$P($T(+2),";",3)_" Patch "_$P($T(+2),";",5)_".",IOM))
|
|
;
|
|
NEW XBQUIT
|
|
S XBQUIT=0
|
|
I '$$VCHK("XB","3.0",2,"'=") S XBQUIT=2
|
|
;
|
|
NEW DA,DIC
|
|
S X="XB",DIC="^DIC(9.4,",DIC(0)="",D="C"
|
|
D IX^DIC
|
|
I Y<0,$D(^DIC(9.4,"C","XB")) D S XBQUIT=2
|
|
. D BMES^XPDUTL($$CJ^XLFSTR("You Have More Than One Entry In The",IOM)),MES^XPDUTL($$CJ^XLFSTR("PACKAGE File with an ""XB"" prefix.",IOM))
|
|
. D MES^XPDUTL($$CJ^XLFSTR(IORVON_"One entry needs to be deleted."_IORVOFF,IOM))
|
|
. D MES^XPDUTL($$CJ^XLFSTR("FIX IT! Before Proceeding.",IOM))
|
|
.Q
|
|
;
|
|
I $G(XPDENV)=1 D
|
|
. S (XPDDIQ("XPZ1"),XPDDIQ("XPZ2"))=0
|
|
. Q:DUZ(0)["@"
|
|
. D BMES^XPDUTL("I need ""@"" in your DUZ(0) for the install to work.")
|
|
. D MES^XPDUTL("In programmer mode, D P^DI,^XUP, and select ""XPD MAIN"" when you're prompted")
|
|
. D MES^XPDUTL("for OPTION NAME.")
|
|
. S XBQUIT=2
|
|
.Q
|
|
;
|
|
I XBQUIT D SORRY(XBQUIT) Q
|
|
;
|
|
D BMES^XPDUTL($$CJ^XLFSTR("ENVIRONMENT OK.",IOM))
|
|
;
|
|
I '$$DIR^XBDIR("E","","","","","",2) D SORRY(2)
|
|
Q
|
|
;
|
|
SORRY(X) ;
|
|
KILL DIFQ
|
|
S XPDQUIT=X
|
|
W:'$D(ZTQUEUED) *7,!,$$CJ^XLFSTR(IORVON_"Sorry...."_IORVOFF,IOM),$$DIR^XBDIR("E","Press RETURN")
|
|
Q
|
|
;
|
|
VCHK(XBPRE,XBVER,XBQUIT,XBCOMP) ; Check versions needed.
|
|
;
|
|
NEW XBV
|
|
S XBV=$$VERSION^XPDUTL(XBPRE)
|
|
W !,$$CJ^XLFSTR("Need "_$S(XBCOMP="<":"at least ",1:"")_XBPRE_" v "_XBVER_"....."_XBPRE_" v "_XBV_" Present",IOM)
|
|
I @(""""_XBV_""""_XBCOMP_""""_XBVER_"""") Q 0
|
|
Q 1
|
|
;
|
|
;
|
|
PRE ;EP - From KIDS.
|
|
Q
|
|
D BMES^XPDUTL("Begin 'PRE^XB3P9' at "_$$FMTE^XLFDT($$NOW^XLFDT)_".")
|
|
D BMES^XPDUTL("End 'PRE^XB3P9' at "_$$FMTE^XLFDT($$NOW^XLFDT)_".")
|
|
Q
|
|
;
|
|
POST ;EP - From KIDS.
|
|
D BMES^XPDUTL("Begin 'POST^XB3P9' at "_$$FMTE^XLFDT($$NOW^XLFDT)_".")
|
|
;
|
|
D BMES^XPDUTL("Attaching ""XB PACKAGE TRACKING"" option to the Site Manager menu.")
|
|
D ATTACH
|
|
;
|
|
D BMES^XPDUTL("Setting up Q'ing of option 'XBTRK' for every 30 days.")
|
|
D QUE
|
|
;
|
|
I $$VERSION^%ZOSV(1)["Cache" D LOAD
|
|
;
|
|
D BMES^XPDUTL("Delivering XB*3*9 install message to select users...")
|
|
D MAIL
|
|
;
|
|
D BMES^XPDUTL("Creating Task to delete old/unused XB/ZIB routines.")
|
|
D DELR
|
|
;
|
|
D BMES^XPDUTL("End 'POST^XB3P9' at "_$$FMTE^XLFDT($$NOW^XLFDT)_".")
|
|
Q
|
|
;
|
|
ATTACH ; Attach option for protection and interactive access.
|
|
I $$ADD^XPDMENU("XUSITEMGR","XB PACKAGE TRACKING","PTRK",10) D BMES^XPDUTL("....successfully atch'd....allocating Security Keys...") D I 1
|
|
. NEW XB,DA,DIC,DINUM
|
|
. S XB=0,XB("PG")=$O(^DIC(19.1,"B","XUPROGMODE",0)),XB("TRK")=$O(^DIC(19.1,"B","XBZ PACKAGE TRACKING",0))
|
|
. Q:'XB("PG")!'XB("TRK")
|
|
. S DIC(0)="NMQ",DIC("P")=$P(^DD(200,51,0),U,2)
|
|
. F S XB=$O(^XUSEC("XUPROGMODE",XB)) Q:'XB D
|
|
.. Q:$D(^VA(200,XB,51,XB("TRK")))
|
|
.. S DIC="^VA(200,XB,51,",DA(1)=XB,(DINUM,X)=XB("TRK")
|
|
.. D FILE^DICN
|
|
..Q
|
|
.Q
|
|
E D BMES^XPDUTL("....Attachment *FAILED*.")
|
|
Q
|
|
;
|
|
QUE ; Add the option to the OPTION SCHEDULING file.
|
|
NEW DA,DIC
|
|
S DIC=19.2,DIC(0)="L",X="XB PACKAGE TRACKING",DIC("DR")="2////"_$$SCH^XLFDT("1D",DT)_".05;6///30D"
|
|
D ^DIC
|
|
I +Y<0 D BMES^XPDUTL("Entry of ""XB PACKAGE TRACKING"" into OPTION SCHEDULING file failed.") Q
|
|
S DA(1)=+Y,DIC="^DIC(19.2,"_DA(1)_",2,",DIC(0)="",DIC("P")=$P(^DD(19.2,10,0),U,2),XBSYSID(1)="cmbsyb.hqw.ihs.gov",XBSYSID(2)=$P(^AUTTSITE(1,0),U,14)
|
|
KILL DO,DD
|
|
F X="XBSYSID(1)","XBSYSID(2)" S DIC("DR")="1///"""_(@X)_"""" D FILE^DICN
|
|
D BMES^XPDUTL("""XB PACKAGE TRACKING"" has been entered into OPTION SCHEDULING file.")
|
|
Q
|
|
;
|
|
MAIL ; Send install mail message.
|
|
NEW DIFROM,XMSUB,XMDUZ,XMTEXT,XMY
|
|
KILL ^TMP("XB3P9MS",$J)
|
|
S ^TMP("XB3P9MS",$J,1)=" --- XB v 3, Patch 9, has been installed ---"
|
|
S %=0
|
|
F S %=$O(^XTMP("XPDI",XPDA,"BLD",XPDBLD,1,%)) Q:'% S ^TMP("XB3P9MS",$J,(%+1))=" "_^(%,0)
|
|
S XMSUB=$P($P($T(+1),";",2)," ",3,99),XMDUZ=$S($G(DUZ):DUZ,1:.5),XMTEXT="^TMP(""XB3P9MS"",$J,",XMY(1)="",XMY(DUZ)=""
|
|
F %="XUMGR","XUPROG","XUPROGMODE" D SINGLE(%)
|
|
D ^XMD
|
|
KILL ^TMP("XB3P9MS",$J)
|
|
Q
|
|
;
|
|
SINGLE(K) ; Get holders of a single key K.
|
|
NEW Y
|
|
S Y=0
|
|
Q:'$D(^XUSEC(K))
|
|
F S Y=$O(^XUSEC(K,Y)) Q:'Y S XMY(Y)=""
|
|
Q
|
|
;
|
|
DELR ; Create task to delete unnecessary routines.
|
|
S ZTRTN="DEL^XBDELR(""XBP8"")",ZTDESC="Delete routines in the 'XBP8' namespace.",ZTDTH=$$HADD^XLFDT($H,0,0,30,0),ZTIO="",ZTPRI=1
|
|
D ^%ZTLOAD
|
|
Q
|
|
;
|
|
LOAD ; If Cache', save %-routines into Namespace
|
|
D BMES^XPDUTL("Saving 5 routines as % routines in current Namespace.")
|
|
NEW DIE,DIF,X,XB,XBF,XBL,XBT,XCM,XCN,XCNP
|
|
KILL ^TMP("XB3P9",$J)
|
|
F XB=1:1 S XBL=$P($T(RTN+XB),";",3) Q:'$L(XBL) D
|
|
. S XBF=$P(XBL,U,1),XBT=$P(XBL,U,2)
|
|
. D MES^XPDUTL(" Saving '"_$$LJ^XLFSTR(XBF,8)_"' as '"_$$LJ^XLFSTR(XBT,8)_"'.")
|
|
. S DIF="^TMP(""XB3P9"",$J,",XCNP=0,X=XBF
|
|
. X ^%ZOSF("LOAD")
|
|
. S DIE="^TMP(""XB3P9"",$J,",X=XBT,XCN=0
|
|
. X ^%ZOSF("SAVE")
|
|
. KILL ^TMP("XB3P9",$J)
|
|
.Q
|
|
Q
|
|
;
|
|
RTN ; Routine ^ Rename As
|
|
;;XBCLS^%XBCLS
|
|
;;ZIBGD^%ZIBGD
|
|
;;ZIBRD^%ZIBRD
|
|
;;ZIBCLU0^%ZIBCLU0
|
|
;;ZIBZUCI^%ZUCI
|
|
;
|