| [613] | 1 | XMP2A ;(WASH ISC)/GM/CAP-PackMan Install ;12/04/2002 13:47
|
|---|
| 2 | ;;8.0;MailMan;**10**;Jun 28, 2002
|
|---|
| 3 | ENH I $P(XMR,U,7)]"" D G:$D(XMPKIDS) 2
|
|---|
| 4 | .;check if KIDS format
|
|---|
| 5 | .I $P(XMR,U,7)["K",$$CHECK1("I $E(XMB0,1,5)=""$KID """) S XMPKIDS=1 Q
|
|---|
| 6 | .I $P(XMR,U,7)["X",$$CHECK1("I $E(XMB0,1,11)=""$TXT $KIDS """) S XMPKIDS=1 Q
|
|---|
| 7 | ;check if KIDS but Message Type field got lost
|
|---|
| 8 | I $P(XMR,U,7)="",$$CHECK1("I $E(XMB0,1,5)=""$KID """) S XMPKIDS=1 G 2
|
|---|
| 9 | G 1:$S('$D(DUZ(0)):1,DUZ(0)="@":0,$D(^XUSEC("XUPROGMODE",DUZ)):0,1:1)
|
|---|
| 10 | W !!,$C(7),"Warning: Installing this message will cause a permanent update of globals"
|
|---|
| 11 | W !,"and routines"_$S($P(XMR,U,7)["X":" and run the INIT",1:"")_"." D Q:'Y
|
|---|
| 12 | .N DIR,DIRUT
|
|---|
| 13 | .S DIR(0)="Y",DIR("B")="NO",DIR("A")="Do you really want to do this"
|
|---|
| 14 | .D ^DIR
|
|---|
| 15 | 1 D CHECK D:Y<0 G:'Y Q
|
|---|
| 16 | .N DIR,DIRUT
|
|---|
| 17 | .S DIR(0)="Y",DIR("B")="NO",DIR("A")="This doesn't appear to be an installable message, do you wish to continue"
|
|---|
| 18 | .D ^DIR
|
|---|
| 19 | 2 S XMPASS=1,XMA0=^XMB(3.9,XMZ,0) I $L(XMB0),$L($P(XMA0,U,10)),$D(^("K")) D ^XMPSEC G 3:$S('$D(DUZ(0)):0,DUZ(0)="@":1,$D(^XUSEC("XUPROGMODE",DUZ)):1,1:0)
|
|---|
| 20 | I $P(XMB0," at ",3)["on" S XMPASS=0 D FAIL^XMPSEC
|
|---|
| 21 | I $S('$D(DUZ(0)):1,DUZ(0)="@":0,$D(^XUSEC("XUPROGMODE",DUZ)):0,1:1) G Q
|
|---|
| 22 | 3 G X:XMP2="R",ENI^XMP2:XMPASS'=0
|
|---|
| 23 | W !,"This message may not be installed !!" G Q
|
|---|
| 24 | X G Z:'$D(XMP2),Z:XMP2'="R" K DIR
|
|---|
| 25 | S DIR("A")="ROUTINE(S)",DIR(0)="FO^2:30",DIR("?")="^D HLP^XMP2A"
|
|---|
| 26 | Y D ^DIR K DIRUT G Z:$D(DTOUT)!$D(DUOUT) G:X="" Q:$O(XMP2(""))="",ENI^XMP2
|
|---|
| 27 | I X'?1.A.AN.1"*" W $C(7)," ???" G Y
|
|---|
| 28 | S XMP2(X)="" G Y
|
|---|
| 29 | Z G Q^XMP2
|
|---|
| 30 | Q K DIR G Q^XMP2
|
|---|
| 31 | ENTT ;LIST/PRINT TEXT ONLY
|
|---|
| 32 | N XMI,XMTEXT,XMABORT,XMPAGE
|
|---|
| 33 | S XMI=.999999,XMABORT=0,XMPAGE=1
|
|---|
| 34 | F S XMI=$O(^XMB(3.9,XMZ,2,XMI)) Q:'XMI S XMTEXT=^(XMI,0) D Q:XMABORT
|
|---|
| 35 | . I $E(XMTEXT,1,8)="$END TXT" S XMABORT=1 Q
|
|---|
| 36 | . F D Q:$L(XMTEXT)<IOM!XMABORT!(IOM<2) S XMTEXT=$E(XMTEXT,IOM,999)
|
|---|
| 37 | . . I $Y+3+($E($G(IOST),1,2)="C-")>IOSL D Q:XMABORT
|
|---|
| 38 | . . . I $E($G(IOST),1,2)="C-" W ! D PAGE^XMXUTIL(.XMABORT) Q:XMABORT
|
|---|
| 39 | . . . W @IOF Q:$E($G(IOST),1,2)="C-"
|
|---|
| 40 | . . . D PAGE2HDR^XMJMP1(XMSUBJ,XMZSTR,.XMPAGE)
|
|---|
| 41 | . . E W !
|
|---|
| 42 | . . W $S(IOM>1:$E(XMTEXT,1,IOM-1),1:XMTEXT)
|
|---|
| 43 | Q
|
|---|
| 44 | ENTR ;INSTALL SELECTED ROUTINE(S) [IN XMP2 ARRAY]
|
|---|
| 45 | F I=0:0 S XCN=$O(^XMB(3.9,XMZ,2,XCN)) Q:XCN="" S X=^(XCN,0) I $E(X)="$" S Y=$P(X," ",2),J="" F I=0:0 S J=$O(XMP2(J)),K=$L(J)-1 Q:J="" I $S(J=Y:1,J'?.AN1"*":0,$E(J,1,K)=$E(Y,1,K):1,1:0) D S1^XMP2
|
|---|
| 46 | Q
|
|---|
| 47 | HLP ;Routine selection
|
|---|
| 48 | W !!,"Choose routines that you wish to install from this message by entering",!,"single names or a series (XMP2*=all routines that begin with 'XMP2')."
|
|---|
| 49 | W !,"The message is not checked to see if there are any matches to your input.",!,"It may be helpful to request a SUMMARY of the message first."
|
|---|
| 50 | W !,"Only routines selected for installation are backed up.",!!
|
|---|
| 51 | Q
|
|---|
| 52 | CHECK ;check text header
|
|---|
| 53 | S %="I $E(XMB0,1,5)=""$TXT "",$P(XMB0,""Created ""_$S(XMB0[""BACKUP"":""on "",1:""by ""),2)?1E.E1"" at "".E1"" at "".E",%=$$CHECK1(%)
|
|---|
| 54 | S Y=$S(%:%,1:-1)
|
|---|
| 55 | Q
|
|---|
| 56 | CHECK1(XMCHK) ;Check text header meets condition XMCHK
|
|---|
| 57 | ;returns line number of text header or 0, XMB0=text header
|
|---|
| 58 | N XMCNT,XMFLAG
|
|---|
| 59 | S XMFLAG=0,XMCNT=.999,XMB0=""
|
|---|
| 60 | F S XMCNT=$O(^XMB(3.9,XMZ,2,XMCNT)) Q:'XMCNT S XMB0=$G(^(XMCNT,0)) D Q:'XMCNT
|
|---|
| 61 | .X XMCHK I S XMFLAG=XMCNT,XMCNT=""
|
|---|
| 62 | Q XMFLAG
|
|---|
