source: IHS-VA_UTILITIES-XB/XB3P9.m@ 641

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

Initial commit of XB, move away from sf.net.
Includes kids file and documentation.
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.