source: IHS-VA_UTILITIES-XB/trunk/XB3P9.m@ 1044

Last change on this file since 1044 was 642, checked in by Sam Habiel, 15 years ago

Modified directory structure; moved routines.
File size: 5.1 KB
Line 
1XB3P9 ;IHS/SET/GTH - XB 3 PATCH 9 ; [ 04/21/2003 9:21 AM ]
2 ;;4.0;XB;;Jul 20, 2009;Build 2
3 ;
4 ; IHS/SET/GTH XB*3*9 10/29/2002
5 ;
6 I '$G(IOM) D HOME^%ZIS
7 ;
8 NEW IORVON,IORVOFF
9 S X="IORVON;IORVOFF"
10 D ENDR^%ZISS
11 ;
12 I '$G(DUZ) W !,"DUZ UNDEFINED OR 0." D SORRY(2) Q
13 ;
14 I '$L($G(DUZ(0))) W !,"DUZ(0) UNDEFINED OR NULL." D SORRY(2) Q
15 ;
16 S X=$P(^VA(200,DUZ,0),U)
17 D BMES^XPDUTL($$CJ^XLFSTR("Hello, "_$P(X,",",2)_" "_$P(X,","),IOM))
18 D BMES^XPDUTL($$CJ^XLFSTR("Checking Environment for "_$P($T(+2),";",4)_" V "_$P($T(+2),";",3)_" Patch "_$P($T(+2),";",5)_".",IOM))
19 ;
20 NEW XBQUIT
21 S XBQUIT=0
22 I '$$VCHK("XB","3.0",2,"'=") S XBQUIT=2
23 ;
24 NEW DA,DIC
25 S X="XB",DIC="^DIC(9.4,",DIC(0)="",D="C"
26 D IX^DIC
27 I Y<0,$D(^DIC(9.4,"C","XB")) D S XBQUIT=2
28 . 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))
29 . D MES^XPDUTL($$CJ^XLFSTR(IORVON_"One entry needs to be deleted."_IORVOFF,IOM))
30 . D MES^XPDUTL($$CJ^XLFSTR("FIX IT! Before Proceeding.",IOM))
31 .Q
32 ;
33 I $G(XPDENV)=1 D
34 . S (XPDDIQ("XPZ1"),XPDDIQ("XPZ2"))=0
35 . Q:DUZ(0)["@"
36 . D BMES^XPDUTL("I need ""@"" in your DUZ(0) for the install to work.")
37 . D MES^XPDUTL("In programmer mode, D P^DI,^XUP, and select ""XPD MAIN"" when you're prompted")
38 . D MES^XPDUTL("for OPTION NAME.")
39 . S XBQUIT=2
40 .Q
41 ;
42 I XBQUIT D SORRY(XBQUIT) Q
43 ;
44 D BMES^XPDUTL($$CJ^XLFSTR("ENVIRONMENT OK.",IOM))
45 ;
46 I '$$DIR^XBDIR("E","","","","","",2) D SORRY(2)
47 Q
48 ;
49SORRY(X) ;
50 KILL DIFQ
51 S XPDQUIT=X
52 W:'$D(ZTQUEUED) *7,!,$$CJ^XLFSTR(IORVON_"Sorry...."_IORVOFF,IOM),$$DIR^XBDIR("E","Press RETURN")
53 Q
54 ;
55VCHK(XBPRE,XBVER,XBQUIT,XBCOMP) ; Check versions needed.
56 ;
57 NEW XBV
58 S XBV=$$VERSION^XPDUTL(XBPRE)
59 W !,$$CJ^XLFSTR("Need "_$S(XBCOMP="<":"at least ",1:"")_XBPRE_" v "_XBVER_"....."_XBPRE_" v "_XBV_" Present",IOM)
60 I @(""""_XBV_""""_XBCOMP_""""_XBVER_"""") Q 0
61 Q 1
62 ;
63 ;
64PRE ;EP - From KIDS.
65 Q
66 D BMES^XPDUTL("Begin 'PRE^XB3P9' at "_$$FMTE^XLFDT($$NOW^XLFDT)_".")
67 D BMES^XPDUTL("End 'PRE^XB3P9' at "_$$FMTE^XLFDT($$NOW^XLFDT)_".")
68 Q
69 ;
70POST ;EP - From KIDS.
71 D BMES^XPDUTL("Begin 'POST^XB3P9' at "_$$FMTE^XLFDT($$NOW^XLFDT)_".")
72 ;
73 D BMES^XPDUTL("Attaching ""XB PACKAGE TRACKING"" option to the Site Manager menu.")
74 D ATTACH
75 ;
76 D BMES^XPDUTL("Setting up Q'ing of option 'XBTRK' for every 30 days.")
77 D QUE
78 ;
79 I $$VERSION^%ZOSV(1)["Cache" D LOAD
80 ;
81 D BMES^XPDUTL("Delivering XB*3*9 install message to select users...")
82 D MAIL
83 ;
84 D BMES^XPDUTL("Creating Task to delete old/unused XB/ZIB routines.")
85 D DELR
86 ;
87 D BMES^XPDUTL("End 'POST^XB3P9' at "_$$FMTE^XLFDT($$NOW^XLFDT)_".")
88 Q
89 ;
90ATTACH ; Attach option for protection and interactive access.
91 I $$ADD^XPDMENU("XUSITEMGR","XB PACKAGE TRACKING","PTRK",10) D BMES^XPDUTL("....successfully atch'd....allocating Security Keys...") D I 1
92 . NEW XB,DA,DIC,DINUM
93 . S XB=0,XB("PG")=$O(^DIC(19.1,"B","XUPROGMODE",0)),XB("TRK")=$O(^DIC(19.1,"B","XBZ PACKAGE TRACKING",0))
94 . Q:'XB("PG")!'XB("TRK")
95 . S DIC(0)="NMQ",DIC("P")=$P(^DD(200,51,0),U,2)
96 . F S XB=$O(^XUSEC("XUPROGMODE",XB)) Q:'XB D
97 .. Q:$D(^VA(200,XB,51,XB("TRK")))
98 .. S DIC="^VA(200,XB,51,",DA(1)=XB,(DINUM,X)=XB("TRK")
99 .. D FILE^DICN
100 ..Q
101 .Q
102 E D BMES^XPDUTL("....Attachment *FAILED*.")
103 Q
104 ;
105QUE ; Add the option to the OPTION SCHEDULING file.
106 NEW DA,DIC
107 S DIC=19.2,DIC(0)="L",X="XB PACKAGE TRACKING",DIC("DR")="2////"_$$SCH^XLFDT("1D",DT)_".05;6///30D"
108 D ^DIC
109 I +Y<0 D BMES^XPDUTL("Entry of ""XB PACKAGE TRACKING"" into OPTION SCHEDULING file failed.") Q
110 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)
111 KILL DO,DD
112 F X="XBSYSID(1)","XBSYSID(2)" S DIC("DR")="1///"""_(@X)_"""" D FILE^DICN
113 D BMES^XPDUTL("""XB PACKAGE TRACKING"" has been entered into OPTION SCHEDULING file.")
114 Q
115 ;
116MAIL ; Send install mail message.
117 NEW DIFROM,XMSUB,XMDUZ,XMTEXT,XMY
118 KILL ^TMP("XB3P9MS",$J)
119 S ^TMP("XB3P9MS",$J,1)=" --- XB v 3, Patch 9, has been installed ---"
120 S %=0
121 F S %=$O(^XTMP("XPDI",XPDA,"BLD",XPDBLD,1,%)) Q:'% S ^TMP("XB3P9MS",$J,(%+1))=" "_^(%,0)
122 S XMSUB=$P($P($T(+1),";",2)," ",3,99),XMDUZ=$S($G(DUZ):DUZ,1:.5),XMTEXT="^TMP(""XB3P9MS"",$J,",XMY(1)="",XMY(DUZ)=""
123 F %="XUMGR","XUPROG","XUPROGMODE" D SINGLE(%)
124 D ^XMD
125 KILL ^TMP("XB3P9MS",$J)
126 Q
127 ;
128SINGLE(K) ; Get holders of a single key K.
129 NEW Y
130 S Y=0
131 Q:'$D(^XUSEC(K))
132 F S Y=$O(^XUSEC(K,Y)) Q:'Y S XMY(Y)=""
133 Q
134 ;
135DELR ; Create task to delete unnecessary routines.
136 S ZTRTN="DEL^XBDELR(""XBP8"")",ZTDESC="Delete routines in the 'XBP8' namespace.",ZTDTH=$$HADD^XLFDT($H,0,0,30,0),ZTIO="",ZTPRI=1
137 D ^%ZTLOAD
138 Q
139 ;
140LOAD ; If Cache', save %-routines into Namespace
141 D BMES^XPDUTL("Saving 5 routines as % routines in current Namespace.")
142 NEW DIE,DIF,X,XB,XBF,XBL,XBT,XCM,XCN,XCNP
143 KILL ^TMP("XB3P9",$J)
144 F XB=1:1 S XBL=$P($T(RTN+XB),";",3) Q:'$L(XBL) D
145 . S XBF=$P(XBL,U,1),XBT=$P(XBL,U,2)
146 . D MES^XPDUTL(" Saving '"_$$LJ^XLFSTR(XBF,8)_"' as '"_$$LJ^XLFSTR(XBT,8)_"'.")
147 . S DIF="^TMP(""XB3P9"",$J,",XCNP=0,X=XBF
148 . X ^%ZOSF("LOAD")
149 . S DIE="^TMP(""XB3P9"",$J,",X=XBT,XCN=0
150 . X ^%ZOSF("SAVE")
151 . KILL ^TMP("XB3P9",$J)
152 .Q
153 Q
154 ;
155RTN ; Routine ^ Rename As
156 ;;XBCLS^%XBCLS
157 ;;ZIBGD^%ZIBGD
158 ;;ZIBRD^%ZIBRD
159 ;;ZIBCLU0^%ZIBCLU0
160 ;;ZIBZUCI^%ZUCI
161 ;
Note: See TracBrowser for help on using the repository browser.