source: WorldVistAEHR/trunk/r/MAILMAN-XM/XMP.m@ 701

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

initial load of WorldVistAEHR

File size: 2.8 KB
Line 
1XMP ;(WASH ISC)/THM/CAP-PackMan ;04/17/2002 11:03
2 ;;8.0;MailMan;;Jun 28, 2002
3NOKL G F:$D(^DOPT("XMP"))
4GO K ^DOPT("XMP") S DIK="^DOPT(""XMP"","
5 S ^DOPT("XMP",0)="PackMan function^1N^"
6 F I=1:1 S X=$E($T(TABLE+I),4,99) Q:X="" S ^DOPT("XMP",I,0)=X
7 D IXALL^DIK Q:$D(DIFROM)!'$D(XMZ)
8F D NEW ;Q:Y<0
9FX S DIC="^DOPT(""XMP"",",DIC(0)="AEQZ" D ^DIC W ! K DIC
10 S XMR=^XMB(3.9,XMZ,0) G Q:Y<0 S X=$P(Y(0),U,2,99) K DD,DO,Y
11 I $D(^XMB(3.9,XMZ,2,0)) S XCNP=$P(^(0),U,3)
12 I $D(XCNP),XCNP>1,X["LOAD"!(X["PACK") S Y=$O(^XMB(3.9,XMZ,1,"C",0)) I $L(Y),$S(Y'=XMDUZ&Y:1,Y'=$P(XMR,U,2):1,$O(^(Y))'="":1,1:0) W !,"This message has already been SENT. You may not CHANGE it.",$C(7) G FX
13 I X["LOAD"!(X["PACK"),$S('$D(DUZ(0)):1,DUZ(0)="@":0,$D(^XUSEC("XUPROG",DUZ)):0,1:1) W !,"You do not have the privilege to LOAD packages nor routines nor globals.",$C(7) G FX
14 I X="XI^XMP2",$S('$D(DUZ(0)):1,DUZ(0)="@":0,$D(^XUSEC("XUPROGMODE",DUZ)):0,1:1)
15 I W !!,$C(7),"You may only check the security of this message.",!,$S($P(^XMB(3.9,XMZ,0),U,10)'="":"You will not be allowed to install it.",1:"This message was not secured -- nothing done"),!!
16 D @X D ^%ZISC D Q G FX
17Q W ! K DIE,DIF,XMSUB,XCNP
18 Q
19TABLE ;;;DESCRIPTION^PROGRAM OR TAG^PROGRAM
20 ;;ROUTINE LOAD^LOAD^XMPH
21 ;;GLOBAL LOAD^LOAD^XMPG
22 ;;PACKAGE LOAD^PACK^XMPH
23 ;;SUMMARIZE MESSAGE^XS^XMP2
24 ;;PRINT MESSAGE^XP^XMP2
25 ;;INSTALL/CHECK MESSAGE^XI^XMP2
26 ;;INSTALL SELECTED ROUTINE(S)^XR^XMP2
27 ;;TEXT PRINT/DISPLAY^XT^XMP2
28 ;;COMPARE MESSAGE^XC^XMP2
29 ;;
30 ;;DATA LOAD^LOAD^XMPDAT ***** FILEMANAGER DATA MOVE ***** NOT READY
31 ;;
32 ;;
33KIDS ;from XPDTP
34 D XMZ^XMA2 Q:XMZ<1 S $P(^XMB(3.9,XMZ,0),U,7)="K" G DIFROM
35NEW I $S($D(DIFROM):1,$D(ZTQUEUED):1,$D(XMDF):1,1:0) G DIFROM
36 W !,"Please enter description of PACKMAN Message",!,$C(7)
37 S DWPK=1,DWLW=75,DIC="^TMP(""XMP"",$J,",DIA("P")=3.9
38 S DIWESUB=$G(XMSUB,XMSUBJ)
39 D EN^DIWE
40DIFROM S %="Created ",(DIF,DIE)="^XMB(3.9,XMZ,2,"
41 I $D(DUZ),$D(^VA(200,DUZ,0)) S %=%_"by "_$$NAME^XMXUTIL(DUZ)_" "
42 I $D(^XMB("NETNAME")) S %=%_"at "_$P(^("NETNAME"),U)_" "
43 I $D(DIFROM) S %=%_" (KIDS) "
44 S XMA0=%
45 S XMA=$E($$NOW^XLFDT_"0000",1,12),@(DIF_"0)")="^3.92A^2^2^"_$P(XMA,"."),^(1,0)="$TXT "_XMA0_"on "_$$DOW^XLFDT(XMA)_", "_$$FMTE^XLFDT($P(XMA,".",1),"2Z")_" at "_$E(XMA,9,10)_":"_$E(XMA,11,12)
46 I '$O(^TMP("XMP",$J,0)) S ^XMB(3.9,XMZ,2,2,0)="$END TXT",XCNP=2 G OLD
47 S I=2,J=0,^XMB(3.9,XMZ,2,2,0)=" "
48 F S J=$O(^TMP("XMP",$J,J)) Q:J="" S %=^(J,0) S:$E(%)="$" %=" "_% S I=I+1,^XMB(3.9,XMZ,2,I,0)=%
49 S ^XMB(3.9,XMZ,2,I+1,0)=" ",^XMB(3.9,XMZ,2,I+2,0)="$END TXT",XCNP=I+2,^XMB(3.9,XMZ,2,0)="^3.92A^"_XCNP_U_XCNP_U_$P(XMA,".") K ^TMP("XMP",$J),XMA0,%
50OLD S XCN=0 K ^TMP("XMP",$J),XMA0 I '$D(ZTQUEUED) W !
51O1 D NT Q:+XCN'=XCN Q:X'["$TXT" W:'$D(ZTQUEUED) !,$P(X,"TXT",2,999) G O1
52NT S XCN=$O(@(DIE_XCN_")")) Q:+XCN'=XCN S X=^(XCN,0) Q
53MM S (DIE,DIF)="^XMB(3.9,XMZ,2," G FX
Note: See TracBrowser for help on using the repository browser.