- XMP ;(WASH ISC)/THM/CAP-PackMan ;04/17/2002 11:03
- ;;8.0;MailMan;;Jun 28, 2002
- 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 W ! 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.",$C(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.",$C(7) G FX
- I X="XI^XMP2",$S('$D(DUZ(0)):1,DUZ(0)="@":0,$D(^XUSEC("XUPROGMODE",DUZ)):0,1:1)
- 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"),!!
- 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
- ;;
- ;;
- KIDS ;from XPDTP
- D XMZ^XMA2 Q:XMZ<1 S $P(^XMB(3.9,XMZ,0),U,7)="K" G DIFROM
- NEW I $S($D(DIFROM):1,$D(ZTQUEUED):1,$D(XMDF):1,1:0) G DIFROM
- W !,"Please enter description of PACKMAN Message",!,$C(7)
- S DWPK=1,DWLW=75,DIC="^TMP(""XMP"",$J,",DIA("P")=3.9
- S DIWESUB=$G(XMSUB,XMSUBJ)
- D EN^DIWE
- DIFROM S %="Created ",(DIF,DIE)="^XMB(3.9,XMZ,2,"
- I $D(DUZ),$D(^VA(200,DUZ,0)) S %=%_"by "_$$NAME^XMXUTIL(DUZ)_" "
- I $D(^XMB("NETNAME")) S %=%_"at "_$P(^("NETNAME"),U)_" "
- I $D(DIFROM) S %=%_" (KIDS) "
- S XMA0=%
- 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)
- 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) S:$E(%)="$" %=" "_% S 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 ^TMP("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
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HXMP 2888 printed Feb 18, 2025@23:38:53 Page 2
- XMP ;(WASH ISC)/THM/CAP-PackMan ;04/17/2002 11:03
- +1 ;;8.0;MailMan;;Jun 28, 2002
- 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 ;Q:Y<0
- DO NEW
- FX SET DIC="^DOPT(""XMP"","
- SET DIC(0)="AEQZ"
- DO ^DIC
- WRITE !
- 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.",$CHAR(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.",$CHAR(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 !!,$CHAR(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 ;;
- KIDS ;from XPDTP
- +1 DO XMZ^XMA2
- if XMZ<1
- QUIT
- SET $PIECE(^XMB(3.9,XMZ,0),U,7)="K"
- GOTO DIFROM
- NEW IF $SELECT($DATA(DIFROM):1,$DATA(ZTQUEUED):1,$DATA(XMDF):1,1:0)
- GOTO DIFROM
- +1 WRITE !,"Please enter description of PACKMAN Message",!,$CHAR(7)
- +2 SET DWPK=1
- SET DWLW=75
- SET DIC="^TMP(""XMP"",$J,"
- SET DIA("P")=3.9
- +3 SET DIWESUB=$GET(XMSUB,XMSUBJ)
- +4 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 "_$$NAME^XMXUTIL(DUZ)_" "
- +2 IF $DATA(^XMB("NETNAME"))
- SET %=%_"at "_$PIECE(^("NETNAME"),U)_" "
- +3 IF $DATA(DIFROM)
- SET %=%_" (KIDS) "
- +4 SET XMA0=%
- +5 SET XMA=$EXTRACT($$NOW^XLFDT_"0000",1,12)
- SET @(DIF_"0)")="^3.92A^2^2^"_$PIECE(XMA,".")
- SET ^(1,0)="$TXT "_XMA0_"on "_$$DOW^XLFDT(XMA)_", "_$$FMTE^XLFDT($PIECE(XMA,".",1),"2Z")_" at "_$EXTRACT(XMA,9,10)_":"_$EXTRACT(XMA,11,12)
- +6 IF '$ORDER(^TMP("XMP",$JOB,0))
- SET ^XMB(3.9,XMZ,2,2,0)="$END TXT"
- SET XCNP=2
- GOTO OLD
- +7 SET I=2
- SET J=0
- SET ^XMB(3.9,XMZ,2,2,0)=" "
- +8 FOR
- SET J=$ORDER(^TMP("XMP",$JOB,J))
- if J=""
- QUIT
- SET %=^(J,0)
- if $EXTRACT(%)="$"
- SET %=" "_%
- SET I=I+1
- SET ^XMB(3.9,XMZ,2,I,0)=%
- +9 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 ^TMP("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