1 | XPDZPRE ;FGO/JHS; Pre-Install Checks ; 12/8/05 9:08pm
|
---|
2 | ;;8.0;KERNEL;**L33**;Jul 10, 1995
|
---|
3 | I '$D(DTIME) W !,"DTIME is not set. Calling XUP to set up required variables.",!,"Press RETURN at the Select OPTION NAME: prompt.",!! D ^XUP
|
---|
4 | S (AAQBAK,AAQFTP,AAQINST)=0 S AAQTYP="UNK"
|
---|
5 | ENPAT D UCI^%ZOSV S AAQU=$P(Y,",",1) K Y S (AAQAERR,AAQIERR,AAQSERR,AAQVERR,AAQCALL)=0 S AAQTYP="UNK",RV1="$C(27,91,55,109)",RV0="$C(27,91,109)" ;Reverse Video VT100
|
---|
6 | I AAQINST=0 W !!,"Simple Patch Pre-Install Check - "_AAQU_" - " S X=$$NOW^XLFDT W $$FMTE^XLFDT(X)
|
---|
7 | LOOKUP W !!,"(Press Return to skip automatic Patch Message lookup",!," and use Read a Message or Load a Distribution instead.)",!!
|
---|
8 | W "==> For automatic Patch Message lookup and Install/Check,",!," enter Patch Name in format Namespace*Version*Patch: " R AAQP:DTIME I '$T!(AAQP["^") G EXIT
|
---|
9 | G:AAQP="" ASKRL
|
---|
10 | G:$P(AAQP,"*",1)["Z" CKLOC
|
---|
11 | I $P(AAQP,"*",1)'?2.4UN W $C(7),!!,"Namespace must be 2-4 Uppercase or Numeric with first character being Alpha." G LOOKUP
|
---|
12 | G CKDBA
|
---|
13 | CKLOC I $P(AAQP,"*",1)'?2.4UN1"Z" W $C(7),!!,"Namespace for a LOCAL Patch must be 2-4 Uppercase or Numeric",!,"characters with the first being Alpha and last character a 'Z'." G LOOKUP
|
---|
14 | CKDBA I $P(AAQP,"*",2)="DBA" W $C(7),!!,"This message refers to a DBA patch.",!!,"For Patch Record Updating: METHOD will be FileMan." S AAQTYP="DBA" G DBA
|
---|
15 | I $P(AAQP,"*",2,3)?1.2N1"."1.2N.1(1"V",1"T").2N1"*"1.6N S AAQPRE="Released " G LKUP
|
---|
16 | W $C(7),!!,"Version number must include a whole number and at least one decimal position.",!,"Non-significant zeros in the Patch Name will be ignored for message lookup." G LOOKUP
|
---|
17 | LKUP S AAQP3=$P(AAQP,"*",3),AAQLN3=$L(AAQP3)
|
---|
18 | S AAQP1=$P(AAQP,"*",1),AAQX1=AAQP1,AAQP2=$P(AAQP,"*",2),AAQX2=AAQP2,AAQP12=AAQP1_"*"_AAQP2 ;AAQP12 is for File #9.7 and #437016 lookup
|
---|
19 | I $P($G(AAQX2),".",2)=0 S AAQX2=$P(AAQX2,".0",1) ;Check X.0 versions
|
---|
20 | I $E(AAQX2,1,2)="0." S AAQX2=$E(AAQX2,2,3) ;Check .X versions
|
---|
21 | S AAQX12=AAQX1_"*"_AAQX2,AAQPAT=AAQX12_"*"_AAQP3 ;For #3.9 lookup
|
---|
22 | S AAQPX=AAQPAT,AAQSUBX=AAQPRE_AAQPX
|
---|
23 | LKUP2 W !!,"Looking for message with '"_AAQSUBX_"' in the subject."
|
---|
24 | S AAQBX=$O(^XMB(3.9,"B",AAQSUBX)) I AAQBX'[AAQPX G LOCAL
|
---|
25 | I AAQBX[" TEST " G CKTEST
|
---|
26 | S AAQX=$P(AAQBX,AAQPRE) I $P(AAQX," ")]AAQX1 G LOCAL
|
---|
27 | I $P(AAQBX,"*",2)>AAQX2 G LOCAL
|
---|
28 | S AAQX=$P(AAQBX,AAQX12_"*",2),AAQX=$P(AAQX," ") I AAQX'=AAQP3 G LOCAL
|
---|
29 | CKBX I $D(^XMB(3.9,"B",AAQBX)) S AAQXMZ=0,AAQXMZ=$O(^XMB(3.9,"B",AAQBX,AAQXMZ)) G GOTXM
|
---|
30 | LOCAL I $E(AAQSUBX,1,5)="LOCAL" W !,"Sorry. The automatic lookup could not find this Patch Message." G RML
|
---|
31 | I $E(AAQSUBX,1,8)="Released" S AAQPRE="EMERGENCY "_AAQPRE,AAQSUBX=AAQPRE_AAQPX G LKUP2
|
---|
32 | I $E(AAQSUBX,1,8)="EMERGENC" S AAQSUBX=AAQPX_" TEST" G LKUP2
|
---|
33 | I AAQSUBX[" TEST" S AAQPRE="LOCAL ",AAQSUBX=AAQPRE_AAQPX S AAQX3=AAQP3,AAQPX=AAQX1_"*"_AAQX2_"*"_AAQX3,AAQSUBX="LOCAL "_AAQPX G LKUP2
|
---|
34 | GOTXM W !!,"Found Message: #"_AAQXMZ,!,?6,"Subject: " S AAQSUB=$$SUBGET^XMGAPI0(AAQXMZ),XMZ=AAQXMZ,AAQXM=AAQSUB,AAQRL="R" W AAQSUB,!
|
---|
35 | I AAQSUB["LOCAL " G ASKMSG
|
---|
36 | I AAQSUB[" TEST" G ASKMSG
|
---|
37 | Q:AAQCALL=1
|
---|
38 | G GETSEQ
|
---|
39 | CKTEST S AAQLNS=$L(AAQSUBX) G:$E(AAQBX,1,AAQLNS)'=AAQSUBX LOCAL G CKBX
|
---|
40 | ASKMSG S %=1 R !,"Is this the correct message" D YN^DICN G:$D(DTOUT) EXIT G:%=1 GETSEQ I %=0 W !!,"Answer YES to continue, NO to find next message, or '^' to Exit." G ASKMSG
|
---|
41 | G:%Y="^" EXIT
|
---|
42 | I %=-1 W $C(7) G NOMSG
|
---|
43 | S AAQSUBX=AAQSUB,AAQBX=$O(^XMB(3.9,"B",AAQSUBX)) G CKBX ;Wrong msg
|
---|
44 | S AAQBX=$O(^XMB(3.9,"B",AAQSUBX)) G ASKMSG
|
---|
45 | GETSEQ Q:AAQCALL=1
|
---|
46 | S AAQSUB=$$SUBGET^XMGAPI0(AAQXMZ),AAQSEQ=$P($G(AAQSUB),"SEQ #",2)
|
---|
47 | I $E(AAQSUB,1,6)="LOCAL " S AAQTYP="LOCAL" D SEQTYP G CHKKID
|
---|
48 | I AAQSUB[" TEST" S AAQTYP="TEST" D SEQTYP G CHKKID
|
---|
49 | I AAQSEQ="" D NOSEQ
|
---|
50 | I AAQTYP="DBA" G ENDT
|
---|
51 | CHKKID I $P(^XMB(3.9,AAQXMZ,0),"^",7)="K" G CHKPRE
|
---|
52 | W $C(7),!,"This is not a KIDS PackMan Distribution message."
|
---|
53 | ASKFTP S %=1 R !!,"Does this message refer to a KIDS FTP, or Informational Patch" D YN^DICN G:$D(DTOUT) EXIT G:%=2 LOOKUP I %=0 W !!,"Answer YES to Continue, NO to find another message, or '^' to Exit." G ASKFTP
|
---|
54 | G:%Y="^" EXIT I %=-1 G ASKFTP
|
---|
55 | ASKTYP R !,"Which type of Patch is this (F)TP or (I)nformational?: I// ",AAQTYP:60 G:AAQTYP="^" EXIT W:$E(AAQTYP,1)="F" "TP" W:$E(AAQTYP,1)="I" "nformational"
|
---|
56 | I AAQTYP?1L.E S AAQTYP=$$UP^XLFSTR(AAQTYP)
|
---|
57 | I (AAQTYP="")!(AAQTYP="I") S AAQTYP="I"
|
---|
58 | I $E(AAQTYP,1)'="F",$E(AAQTYP,1)'="I" W !!,"Enter F or I, `^' to quit." G ASKTYP
|
---|
59 | G:AAQTYP="F" CKFTP
|
---|
60 | W !!,"For Patch Record Updating: METHOD will be Informational." S AAQTYP="INFO",AAQRL="I"
|
---|
61 | W !,"BACKUP# will be 0, and UCI DATE/TIME will be NOW.",!,"If default values are incorrect, make changes using Enter/Edit Patch Record." G ENDT
|
---|
62 | CKFTP W !!,"FTP/KIDS Patch Pre-Install.",!!,"For Patch Record Updating: METHOD will be Not Installed." S AAQTYP="FTP",AAQRL="F"
|
---|
63 | W !,"BACKUP# will be 0.",!,"The UCI data and METHOD will be updated after install is finished.",!,"If default values are incorrect, make changes using Enter/Edit Patch Record." G ENDT
|
---|
64 | INFTP S AAQFTP=1,AAQRL="L" G CHKPRE
|
---|
65 | SEQTYP Q:AAQCALL=1 S AAQSEQ=0 D RV1NOTE W "This is a ",AAQTYP," Patch without a valid SEQ #. Zero will be used." S AAQSEQ=0,AAQSERR=1 Q
|
---|
66 | NOSEQ S AAQSEQ=0 D RV1NOTE W "No Patch Sequence number could be found. Zero will be used." S AAQSERR=1 Q
|
---|
67 | ASKRL I AAQFTP=1 S AAQRL="L" G END
|
---|
68 | R !!,"==> Do you want to load this with (R)ead a message,",!,?31,"or (L)oad a Distribution?: L// ",AAQRL:DTIME S:AAQRL="" AAQRL="L" G:AAQRL="^" EXIT I '$T G EXIT
|
---|
69 | I AAQRL?1L.E S AAQRL=$$UP^XLFSTR(AAQRL)
|
---|
70 | I $E(AAQRL,1)'="R",$E(AAQRL,1)'="L" W $C(7),!!,"Enter the letter R or L, `^' to quit." G ASKRL
|
---|
71 | G:AAQRL="L" ASKCHK^XPDZPAT
|
---|
72 | RML Q:AAQCALL=1 W ! S DIC="^XMB(3.9,",DIC(0)="AEQM",DIC("A")="Enter Message Subject or Number: " D ^DIC G:$D(DUOUT)!$D(DTOUT) EXIT I Y=-1 W $C(7),!!,"Invalid Selection. Try again or type '^' to Exit." G RML
|
---|
73 | S AAQXMZ=+Y,XMZ=AAQXMZ,AAQXM=$P(Y,U,2),AAQSEQ=$P($G(AAQXM),"SEQ #",2),AAQP3=$P(Y,U,2) I AAQSEQ="" G CHKP3
|
---|
74 | S AAQSEQ=$P($G(AAQSEQ),U)
|
---|
75 | CHKP3 I AAQP3[" TEST" S AAQTYP="TEST" D SEQTYP S AAQP3=$P(X," "),AAQXM="TEST "_AAQP3 G SEQERR
|
---|
76 | I AAQP3["LOCAL" S AAQTYP="LOCAL" D SEQTYP G SEQERR
|
---|
77 | I AAQSEQ="" D NOSEQ
|
---|
78 | G CHKPRE
|
---|
79 | SEQERR S AAQSERR=1,AAQSEQ=0
|
---|
80 | CHKPRE I $E(AAQXM,1,5)="Relea" S AAQXM=$P(AAQXM,"Released ",2),AAQXM=$P(AAQXM," ")
|
---|
81 | I $E(AAQXM,1,5)="EMERG" S AAQXM=$P(AAQXM,"EMERGENCY Released ",2),AAQXM=$P(AAQXM," ")
|
---|
82 | I $E(AAQXM,1,5)="LOCAL" S AAQXM=$P(AAQXM,"LOCAL ",2),AAQXM=$P(AAQXM," "),AAQX1=$P(AAQXM,"Z")
|
---|
83 | I AAQXM[" TEST" S AAQXM=$P(AAQXM," TEST",1)
|
---|
84 | I AAQP'["*" W !,"This was not identified as a Patch and will be installed as a Package.",! G CHKRL^XPDZPAT
|
---|
85 | S AAQX1=$P(AAQXM,"*"),AAQX2=$P(AAQXM,"*",2),AAQX3=$P(AAQXM,"*",3),AAQX3=$P(AAQX3," ")
|
---|
86 | I $E(AAQX2,1,1)="." S AAQX2="0"_AAQX2
|
---|
87 | I AAQX2'["." S AAQX2=AAQX2_".0"
|
---|
88 | D VERS^XPDZPRE1 G END
|
---|
89 | DBA I AAQCALL=0 W !,"BACKUP# will be 0, and UCI DATE/TIME will be NOW.",!,"If default values are incorrect, make changes using Enter/Edit Patch Record."
|
---|
90 | S AAQPX=AAQP,AAQPRE="Released ",AAQSUB=AAQPRE_AAQPX G LKUP
|
---|
91 | RV1NOTE W !!,@RV1,"NOTE:",@RV0,$C(7)," " Q
|
---|
92 | NOMSG I AAQXMZ=0 W $C(7),!!,"No message has been found and read. Exiting." H 2 G EXIT
|
---|
93 | END I AAQFTP=1 S AAQRL="L"
|
---|
94 | E S AAQRL="R"
|
---|
95 | G:AAQU="TST" ENDT I $E(AAQAP,1,8)="No Assoc" W !,AAQAP
|
---|
96 | ENDT S AAQCONT=0,AAQTOT=AAQAERR+AAQIERR+AAQSERR+AAQVERR I AAQTOT>0 W !!,@RV1,"Discrepancies were Noted.",@RV0 S AAQCONT=2
|
---|
97 | S AAQR=$G(^%ZOSF("VOL")) ;Pick up volume such as ROU,LOU,COU...
|
---|
98 | I AAQU="VAH" S AAQSITE=^XMB("NETNAME"),AAQSITE="TEST."_^XMB("NETNAME"),AAQXMY=$P(^VA(200,DUZ,0),"^",1)_"@"_AAQSITE
|
---|
99 | I AAQU="VAH",(AAQR="ROU"),(AAQXMY'["TEST.TEST"),(AAQXMY'["VISN13-APPS"),(AAQXMY'["CENTRAL-PLAINS") S XMY(AAQXMY)="" D ENT1^XMD W !!,"Forwarding message #"_XMZ_" to "_AAQXMY
|
---|
100 | I AAQU="VAH",(AAQXMY["VISN13-APPS") S $P(AAQXMY,"@",2)="TEST.V23IRM.VA.GOV" S XMY(AAQXMY)="" D ENT1^XMD W !!,"Forwarding message #"_XMZ_" to "_AAQXMY ;Added line 07-30-2003/JFW MPLS
|
---|
101 | I AAQU="VAH",(AAQXMY["CENTRAL-PLAINS") S $P(AAQXMY,"@",2)="TEST.VISN14.MED.VA.GOV" S XMY(AAQXMY)="" D ENT1^XMD W !!,"Forwarding message #"_XMZ_" to "_AAQXMY ;Added line 08-19-2003/JFW MPLS
|
---|
102 | I AAQFTP=1 D LKUP^XPDZPRE1
|
---|
103 | I AAQP2="DBA" D LKUP^XPDZPRE1 G EXIT
|
---|
104 | I AAQRL="I" D LKUP^XPDZPRE1 G EXIT
|
---|
105 | I AAQRL="F" D ^XPDZPRE1,LKUP^XPDZPRE1 G EXIT
|
---|
106 | G:AAQCONT=2 CHKINST
|
---|
107 | S AAQCONT=1
|
---|
108 | CHKINST I AAQINST=0 K AAQP,AAQU,AAQXMZ R !!," Press RETURN to Continue:",X:DTIME W @IOF G EXIT
|
---|
109 | S %=AAQCONT
|
---|
110 | ASKINS R !!,"Do you want to Continue with the Install" D YN^DICN G:$D(DTOUT) EXIT G:%=1 CHKRL^XPDZPAT I %=0 W !!,"Answer YES to Continue with Install, NO to stop at this point." G ASKINS
|
---|
111 | G:%Y="^" EXIT
|
---|
112 | I %=-1 W $C(7) G ASKINS
|
---|
113 | S AAQINST=0
|
---|
114 | EXIT W ! K AAQBX,AAQLN3,AAQLNS,AAQP1,AAQP12,AAQP2,AAQP3,AAQPAT,AAQPNO,AAQPRE,AAQPV,AAQPX,AAQSITE,AAQSUB,AAQSUBX,AAQX,AAQX1,AAQX12,AAQX2,AAQX3,AAQXM,AAQXMY,AAQXMZ
|
---|
115 | D EXPRE^XPDZPAT K %,%A,%C,%D,%DT,%M,%NX,%Y,DIC,X,XMZ,Y
|
---|
116 | I AAQFTP="^" G EXIT^XPDZPAT ;AAQRL,AAQDT Killed by XPZPAT
|
---|
117 | K AAQBAK,AAQCALL,AAQFTP,AAQINST,AAQLN,AAQP,AAQRL,AAQSEQ,AAQU,DLAYGO Q ;Other variables killed by EXPRE^XPDZPAT
|
---|