| 1 | AAQJSERV ;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
|
|---|
| 10 | UNLOAD F CNT=2:1 X XMREC Q:XMER'=0 S ^TMP("AAQJRCV",$J,CNT)=XMRG
|
|---|
| 11 | Q
|
|---|
| 12 | CLEANUP S XMSER="S."_XQSOP,XMZ=XQMSG D REMSBMSG^XMA1C
|
|---|
| 13 | K ^TMP("AAQJRCV",$J),XMER,XMREC,XMRG,XMZ,XQMSG,XQSOP
|
|---|
| 14 | Q
|
|---|
| 15 | PAC ; 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
|
|---|
| 37 | EXIT 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
|
|---|
| 40 | ERR(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
|
|---|
| 46 | FILE ; 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
|
|---|
| 69 | UPDT 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)
|
|---|
| 73 | CHKUCI 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
|
|---|
| 80 | SETU 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
|
|---|
| 84 | LOCK 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
|
|---|
| 87 | CHKLOC Q:AAQX1'["Z"
|
|---|
| 88 | S AAQX1=$P(AAQX1,"Z",1),AAQLOC=1
|
|---|
| 89 | Q
|
|---|
