source: WorldVistAEHR/trunk/r/PATCH_MANAGEMNT-AAQ/AAQJSERV.m@ 1610

Last change on this file since 1610 was 613, checked in by George Lilly, 16 years ago

initial load of WorldVistAEHR
File size: 4.6 KB
RevLine 
[613]1AAQJSERV ;FGO/JHS; Update TST Patch UCI (#436016) ;01-28-99 [6/6/01 2:41pm]
2 ;;1.4;AAQJ PATCH RECORD;; May 14, 1999
3 N CNT,DOMAIN,INSTBY,INSTNAME,PACKAGE,ENV,SITE,START,STOP,VERSION,XMDUZ,XMSER,XMSUB,XMTEXT,XMY
4 K ^TMP("AAQJRCV",$J),^TMP("AAQJSND",$J) S AAQBY=""
5 X XMREC I XMER'=0 S ^TMP($J,"AAQJRCV",$J,1)="" D ERR("NO MESSAGE"),CLEANUP Q
6 S ^TMP("AAQJRCV",$J,1)=XMRG
7 I $E(XMRG,1,15)="PACKAGE INSTALL" D UNLOAD,PAC,CLEANUP Q
8 D UNLOAD,ERR("BAD FORMAT"),CLEANUP
9 Q
10UNLOAD F CNT=2:1 X XMREC Q:XMER'=0 S ^TMP("AAQJRCV",$J,CNT)=XMRG
11 Q
12CLEANUP S XMSER="S."_XQSOP,XMZ=XQMSG D REMSBMSG^XMA1C
13 K ^TMP("AAQJRCV",$J),XMER,XMREC,XMRG,XMZ,XQMSG,XQSOP
14 Q
15PAC ; Extract data from message
16 S DOMAIN=$P($G(^TMP("AAQJRCV",$J,2)),": ",2)
17 S PACKAGE=$P($G(^TMP("AAQJRCV",$J,3)),": ",2,99)
18 S VERSION=$P($G(^TMP("AAQJRCV",$J,4)),": ",2)
19 S START=$P($G(^TMP("AAQJRCV",$J,5)),": ",2)
20 S STOP=$P($G(^TMP("AAQJRCV",$J,6)),": ",2)
21 S ENV=$P($G(^TMP("AAQJRCV",$J,7)),": ",2)
22 S INSTBY=$P($G(^TMP("AAQJRCV",$J,8)),": ",2)
23 S INSTNAME=$P($G(^TMP("AAQJRCV",$J,9)),": ",2)
24 ; Only update sites and applications being tracked
25 I '$L(DOMAIN) D ERR("NO DOMAIN") Q
26 I '$L(PACKAGE) D ERR("NO PACKAGE") Q
27 I 'VERSION D ERR("NO VERSION") Q
28 I VERSION'[".",VERSION=+VERSION S VERSION=VERSION_".0"
29 S X=$P($G(^XTV(8989.3,1,0)),U,1) I X="" D ERR("NO DOMAIN NAME") Q
30 D UCI^%ZOSV S AAQUCI=$P(Y,",",1),AAQDOM=$P(^DIC(4.2,X,0),U,1),AAQDOM="TEST."_AAQDOM
31 I DOMAIN["MED" S DOMAIN1=$P(DOMAIN,".MED.VA.GOV")
32 E S DOMAIN1=$P(DOMAIN,".VA.GOV")
33 I AAQDOM["MED" S AAQDOM1=$P(AAQDOM,".MED.VA.GOV")
34 E S AAQDOM1=$P(AAQDOM,".VA.GOV")
35 I DOMAIN1'=AAQDOM1 D ERR("WRONG SITE-"_DOMAIN) Q
36 D FILE
37EXIT W ! K %,%DT,%Y,AAQBY,AAQCOMM,AAQDOM,AAQDOM1,AAQDT,AAQDUZ,AAQIRM,AAQLOC,AAQMETH,AAQP,AAQPM,AAQPNO,AAQPV,AAQSITN,AAQSYS,AAQT,AAQTM,AAQUCI,AAQUNO,AAQUV,AAQV,AAQVER,AAQX,AAQX1,AAQX12,AAQX2,AAQX3
38 K D0,DD,DOMAIN1,DR,MSG,XMER,XMREC,XMRG
39 Q
40ERR(ERRMSG) ; Returns an error message to 'Installed by' user
41 S CNT=0 F S CNT=$O(^TMP("AAQJRCV",$J,CNT)) Q:CNT<1 S ^TMP("AAQJSND",$J,CNT,0)=^(CNT)
42 S ^(0)=^TMP("AAQJSND",$J,1,0)_" ***"_ERRMSG_"***"
43 S XMY(DUZ)="",XMDUZ="Patch Updating Error",XMTEXT="^TMP(""AAQJSND"",$J,",XMSUB=$E("Update Error-"_ERRMSG,1,55)
44 D ^XMD
45 Q
46FILE ; Date is not changed if a date already exists for this Patch
47 S AAQLOC=0
48 N DA,DIC,DIE,DLAYGO,DR,X,Y
49 S AAQP=INSTNAME,X=AAQP Q:$L(X)>50!($L(X)<3)
50 Q:X'["*" I X["*" K:$P(X,"*",2,3)'?1.2N1"."1.2N.1(1"V",1"T").2N1"*"1.6N X
51 G:'$D(X) EXIT
52 S AAQMETH=$P(ENV,U,5),AAQCOMM=$P(ENV,U,6)
53 I INSTBY["^" S AAQBY=$P(INSTBY,U),AAQSITN=$P(INSTBY,U,2)
54 S AAQUV=$P(ENV,U,1)_","_$P(ENV,U,2)
55 S AAQX1=$P(AAQP,"*",1),AAQX2=$P(AAQP,"*",2) D CHKLOC S AAQX12=AAQX1_"*"_AAQX2
56 S AAQX3=$P(AAQP,"*",3) I $L(AAQX3)<2 S AAQX3="0"_AAQX3 K DD,DIC,D0
57 I AAQLOC=1 S AAQX3="L"_AAQX3
58 I AAQCOMM["TEST v" S AAQVER=$P(AAQCOMM,"TEST v",2),AAQX3=AAQX3_"V"_AAQVER
59 S X=AAQX12,DIC="^DIZ(437016,",DIC(0)="XM" D ^DIC I +Y>0 S AAQPV=+Y
60 I '$D(^DIZ(437016,"B",AAQX12)) D
61 .S X=AAQX12,DIC="^DIZ(437016," S DIC(0)="ML" D FILE^DICN
62 .S AAQPV=+Y
63 I $D(^DIZ(437016,AAQPV,1,"B",AAQX3)) S DA=0,DA=$O(^DIZ(437016,AAQPV,1,"B",AAQX3,DA)) Q:DA="" S AAQPNO=DA,DA(1)=AAQPV,DIC="^DIZ(437016,"_DA(1)_",1," G UPDT
64 I '$D(^DIZ(437016,AAQPV,1,"B",AAQX3)) D
65 .S:'$D(^DIZ(437016,AAQPV,1,0)) DIC("P")=$P(^DD(437016,1,0),"^",2)
66 .S DA(1)=AAQPV,DIC="^DIZ(437016,"_DA(1)_",1,",X=AAQX3,DIC(0)="XL",DLAYGO=437016
67 .D ^DIC I Y=-1 Q ;No updating if msg for PKG install or no PKG*VER
68 .S AAQPNO=+Y
69UPDT S %DT="FRS",X=STOP D ^%DT S AAQDT=Y
70 I AAQBY'="" S INSTBY=AAQBY
71 I '$D(^VA(200,"B",INSTBY)) S AAQIRM="UNK" G CHKUCI
72 S AAQDUZ=0,AAQDUZ=$O(^VA(200,"B",INSTBY,AAQDUZ)),AAQIRM=$P(^VA(200,AAQDUZ,0),U,2)
73CHKUCI I '$D(^DIZ(437016,AAQPV,1,AAQPNO,2,0)) S ^(0)="^437016.13S^^" S (AAQUNO,AAQT,AAQV)=0 G SETU
74 S AAQX=^DIZ(437016,AAQPV,1,AAQPNO,2,0) I ($P(AAQX,U,4)=0)!($P(AAQX,U,4)="") S (AAQUNO,AAQT,AAQV)=0 G SETU
75 S (AAQT,AAQV,AAQX)=0 F S AAQX=$O(^DIZ(437016,AAQPV,1,AAQPNO,2,AAQX)) Q:AAQX="" D
76 .S AAQSYS=^DIZ(437016,AAQPV,1,AAQPNO,2,AAQX,0)
77 .I $E(AAQSYS,1,1)="T" S AAQT=AAQT+1
78 .I $E(AAQSYS,1,1)="V" S AAQV=AAQV+1
79 I AAQT>0 D ERR("TST ALREADY ON FILE") Q
80SETU K DD,D0 S AAQSYS="T",DIC="^DIZ(437016,"_AAQPV_",1,"_AAQPNO_",2,",DIC(0)="XLM",X=AAQSYS,DA(1)=AAQPNO,DA(2)=AAQPV D FILE^DICN S AAQUNO=+Y K DIC
81 S DIE="^DIZ(437016,"_AAQPV_",1,"_AAQPNO_",2,",DA(2)=AAQPV,DA(1)=AAQPNO,DA=AAQUNO,DR="1///^S X=AAQDT;2///^S X=AAQIRM" D ^DIE
82 G:AAQX2="DBA" LOCK
83 S AAQPM="PM",DIE="^DIZ(437016,"_AAQPV_",1,",DA(1)=AAQPV,DA=AAQPNO,DR="1.5////^S X=AAQPM" D ^DIE
84LOCK L -^DIZ(437016,AAQPV,1,AAQPNO,0)
85 L +^DIZ(437016,1,AAQPNO,0):20 ELSE S MSG="Unable to post data for Patch"_INSTNAME_" due to record lock." D ERR("RECORD LOCK") Q
86 Q
87CHKLOC Q:AAQX1'["Z"
88 S AAQX1=$P(AAQX1,"Z",1),AAQLOC=1
89 Q
Note: See TracBrowser for help on using the repository browser.