XMP ;(WASH ISC)/THM/CAP-PackMan Version 1.01 ;7/6/90 14:13 ;
;;7.1;Mailman;**1003**;OCT 27, 1998
;;7.1;MailMan;**1**;Jun 02, 1994
NOKL G F:$D(^DOPT("XMP"))
GO K ^DOPT("XMP") S DIK="^DOPT(""XMP"","
S ^DOPT("XMP",0)="PackMan function^1N^"
F I=1:1 S X=$E($T(TABLE+I),4,99) Q:X="" S ^DOPT("XMP",I,0)=X
D IXALL^DIK Q:$D(DIFROM)!'$D(XMZ)
F D NEW Q:Y<0
FX S DIC="^DOPT(""XMP"",",DIC(0)="AEQZ" D ^DIC K DIC
S XMR=^XMB(3.9,XMZ,0) G Q:Y<0 S X=$P(Y(0),U,2,99) K DD,DO,Y
I $D(^XMB(3.9,XMZ,2,0)) S XCNP=$P(^(0),U,3)
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.",*7 G FX
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.",*7 G FX
I X="XI^XMP2",$S('$D(DUZ(0)):1,DUZ(0)="@":0,$D(^XUSEC("XUPROGMODE",DUZ)):0,1:1)
I W !!,*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"),!!
D @X D ^%ZISC D Q G FX
Q W ! K DIE,DIF,XMSUB,XCNP
Q
TABLE ;;;DESCRIPTION^PROGRAM OR TAG^PROGRAM
;;ROUTINE LOAD^LOAD^XMPH
;;GLOBAL LOAD^LOAD^XMPG
;;PACKAGE LOAD^PACK^XMPH
;;SUMMARIZE MESSAGE^XS^XMP2
;;PRINT MESSAGE^XP^XMP2
;;INSTALL/CHECK MESSAGE^XI^XMP2
;;INSTALL SELECTED ROUTINE(S)^XR^XMP2
;;TEXT PRINT/DISPLAY^XT^XMP2
;;COMPARE MESSAGE^XC^XMP2
;;
;;DATA LOAD^LOAD^XMPDAT ***** FILEMANAGER DATA MOVE ***** NOT READY
;;
;;
NEW I $S($D(DIFROM):1,$D(ZTQUEUED):1,$D(XMDF):1,1:0) G DIFROM
W !,"Please enter description of PACKMAN Message",!,*7
S DWPK=1,DWLW=75,DIC="^TMP(""XMP"",$J," D EN^DIWE
DIFROM S %="Created ",(DIF,DIE)="^XMB(3.9,XMZ,2,"
I $D(DUZ),$D(^VA(200,DUZ,0)) S %=%_"by "_$P(^(0),U)_" "
I $D(^XMB("NAME")) S %=%_"at "_$P(^("NAME"),U)_" "
I $D(DIFROM) S %=%_" (DIFROM) "
S %DT="T",X="NOW",XMA0=% D ^%DT
S (XMA,X)=Y D DW^%DTC
S XMA=$E(XMA_"0000",1,12),@(DIF_"0)")="^3.92A^2^2^"_$P(XMA,"."),^(1,0)="$TXT "_XMA0_"on "_X_", "_$E(XMA,4,5)_"/"_$E(XMA,6,7)_"/"_$E(XMA,2,3)_" at "_$E(XMA,9,10)_":"_$E(XMA,11,12)
I '$O(^TMP("XMP",$J,0)) S ^XMB(3.9,XMZ,2,2,0)="$END TXT",XCNP=2 G OLD
S I=2,J=0,^XMB(3.9,XMZ,2,2,0)=" "
F S J=$O(^TMP("XMP",$J,J)) Q:J="" S %=" "_^(J,0),I=I+1,^XMB(3.9,XMZ,2,I,0)=%
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,%
OLD S XCN=0 K ^XMP("XMP",$J),XMA0 I '$D(ZTQUEUED) W !
O1 D NT Q:+XCN'=XCN Q:X'["$TXT" W:'$D(ZTQUEUED) !,$P(X,"TXT",2,999) G O1
NT S XCN=$O(@(DIE_XCN_")")) Q:+XCN'=XCN S X=^(XCN,0) Q
MM S (DIE,DIF)="^XMB(3.9,XMZ,2," G FX
XMP ;(WASH ISC)/THM/CAP-PackMan Version 1.01 ;7/6/90 14:13 ;
+1 ;;7.1;Mailman;**1003**;OCT 27, 1998
+2 ;;7.1;MailMan;**1**;Jun 02, 1994
NOKL IF $DATA(^DOPT("XMP"))
GOTO F
GO KILL ^DOPT("XMP")
SET DIK="^DOPT(""XMP"","
+1 SET ^DOPT("XMP",0)="PackMan function^1N^"
+2 FOR I=1:1
SET X=$EXTRACT($TEXT(TABLE+I),4,99)
IF X=""
QUIT
SET ^DOPT("XMP",I,0)=X
+3 DO IXALL^DIK
IF $DATA(DIFROM)!'$DATA(XMZ)
QUIT
F DO NEW
IF Y<0
QUIT
FX SET DIC="^DOPT(""XMP"","
SET DIC(0)="AEQZ"
DO ^DIC
KILL DIC
+1 SET XMR=^XMB(3.9,XMZ,0)
IF Y<0
GOTO Q
SET X=$PIECE(Y(0),U,2,99)
KILL DD,DO,Y
+2 IF $DATA(^XMB(3.9,XMZ,2,0))
SET XCNP=$PIECE(^(0),U,3)
+3 IF $DATA(XCNP)
IF XCNP>1
IF X["LOAD"!(X["PACK")
SET Y=$ORDER(^XMB(3.9,XMZ,1,"C",0))
IF $LENGTH(Y)
IF $SELECT(Y'=XMDUZ&Y:1,Y'=$PIECE(XMR,U,2):1,$ORDER(^(Y))'="":1,1:0)
WRITE !,"This message has already been SENT. You may not CHANGE it.",*7
GOTO FX
+4 IF X["LOAD"!(X["PACK")
IF $SELECT('$DATA(DUZ(0)):1,DUZ(0)="@":0,$DATA(^XUSEC("XUPROG",DUZ)):0,1:1)
WRITE !,"You do not have the privilege to LOAD packages nor routines nor globals.",*7
GOTO FX
+5 IF X="XI^XMP2"
IF $SELECT('$DATA(DUZ(0)):1,DUZ(0)="@":0,$DATA(^XUSEC("XUPROGMODE",DUZ)):0,1:1)
+6 IF $TEST
WRITE !!,*7,"You may only check the security of this message.",!,$SELECT($PIECE(^XMB(3.9,XMZ,0),U,10)'="":"You will not be allowed to install it.",1:"This message was not secured -- nothing done"),!!
+7 DO @X
DO ^%ZISC
DO Q
GOTO FX
Q WRITE !
KILL DIE,DIF,XMSUB,XCNP
+1 QUIT
TABLE ;;;DESCRIPTION^PROGRAM OR TAG^PROGRAM
+1 ;;ROUTINE LOAD^LOAD^XMPH
+2 ;;GLOBAL LOAD^LOAD^XMPG
+3 ;;PACKAGE LOAD^PACK^XMPH
+4 ;;SUMMARIZE MESSAGE^XS^XMP2
+5 ;;PRINT MESSAGE^XP^XMP2
+6 ;;INSTALL/CHECK MESSAGE^XI^XMP2
+7 ;;INSTALL SELECTED ROUTINE(S)^XR^XMP2
+8 ;;TEXT PRINT/DISPLAY^XT^XMP2
+9 ;;COMPARE MESSAGE^XC^XMP2
+10 ;;
+11 ;;DATA LOAD^LOAD^XMPDAT ***** FILEMANAGER DATA MOVE ***** NOT READY
+12 ;;
+13 ;;
NEW IF $SELECT($DATA(DIFROM):1,$DATA(ZTQUEUED):1,$DATA(XMDF):1,1:0)
GOTO DIFROM
+1 WRITE !,"Please enter description of PACKMAN Message",!,*7
+2 SET DWPK=1
SET DWLW=75
SET DIC="^TMP(""XMP"",$J,"
DO EN^DIWE
DIFROM SET %="Created "
SET (DIF,DIE)="^XMB(3.9,XMZ,2,"
+1 IF $DATA(DUZ)
IF $DATA(^VA(200,DUZ,0))
SET %=%_"by "_$PIECE(^(0),U)_" "
+2 IF $DATA(^XMB("NAME"))
SET %=%_"at "_$PIECE(^("NAME"),U)_" "
+3 IF $DATA(DIFROM)
SET %=%_" (DIFROM) "
+4 SET %DT="T"
SET X="NOW"
SET XMA0=%
DO ^%DT
+5 SET (XMA,X)=Y
DO DW^%DTC
+6 SET XMA=$EXTRACT(XMA_"0000",1,12)
SET @(DIF_"0)")="^3.92A^2^2^"_$PIECE(XMA,".")
SET ^(1,0)="$TXT "_XMA0_"on "_X_", "_$EXTRACT(XMA,4,5)_"/"_$EXTRACT(XMA,6,7)_"/"_$EXTRACT(XMA,2,3)_" at "_$EXTRACT(XMA,9,10)_":"_$EXTRACT(XMA,11,12)
+7 IF '$ORDER(^TMP("XMP",$JOB,0))
SET ^XMB(3.9,XMZ,2,2,0)="$END TXT"
SET XCNP=2
GOTO OLD
+8 SET I=2
SET J=0
SET ^XMB(3.9,XMZ,2,2,0)=" "
+9 FOR
SET J=$ORDER(^TMP("XMP",$JOB,J))
IF J=""
QUIT
SET %=" "_^(J,0)
SET I=I+1
SET ^XMB(3.9,XMZ,2,I,0)=%
+10 SET ^XMB(3.9,XMZ,2,I+1,0)=" "
SET ^XMB(3.9,XMZ,2,I+2,0)="$END TXT"
SET XCNP=I+2
SET ^XMB(3.9,XMZ,2,0)="^3.92A^"_XCNP_U_XCNP_U_$PIECE(XMA,".")
KILL ^TMP("XMP",$JOB),XMA0,%
OLD SET XCN=0
KILL ^XMP("XMP",$JOB),XMA0
IF '$DATA(ZTQUEUED)
WRITE !
O1 DO NT
IF +XCN'=XCN
QUIT
IF X'["$TXT"
QUIT
IF '$DATA(ZTQUEUED)
WRITE !,$PIECE(X,"TXT",2,999)
GOTO O1
NT SET XCN=$ORDER(@(DIE_XCN_")"))
IF +XCN'=XCN
QUIT
SET X=^(XCN,0)
QUIT
MM SET (DIE,DIF)="^XMB(3.9,XMZ,2,"
GOTO FX
