Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: XMP2

XMP2.m

Go to the documentation of this file. 
  1. XMP2 ;(WASH ISC)/GM/CAP-PackMan Print/Install/Summarize/Compare ;04/17/2002  11:07
  1.  ;;8.0;MailMan;;Jun 28, 2002
  1.  ; Entry points used by MailMan options (not covered by DBIA):
  1.  ; XC     XMPCOM - Compare message
  1.  ; XI     XMPINS - Install message
  1.  ; XP     XMPPRT - Print message
  1.  ; XS     XMPSUM - Summarize message
  1.  ;;XMP2 IS INSTALLED AS XMP2Z TO AVOID CLOBBER ERRORS / FILE AS XMP2
  1.  Q
  1.  ;
  1. LIST ;LIST MESSAGE
  1.  S XCN=.999 F M=1:1 D NT Q:+XCN'=XCN  W !,X
  1.  Q
  1.  ;
  1.  ;
  1. PP ;PRETTY PRINT
  1.  S:'$D(XCN) XCN=.999 S XCN=+XCN K XMOUT
  1.  F I=1:1 D NT Q:XCN'=+XCN  Q:$E(X)="$"  D @($P("P1,G1,G2,K1",",",%1)) Q:$D(XMOUT)
  1.  Q
  1.  ;
  1. P1 Q:X?1"KEY ;;;".E
  1.  I XMP2="T" W !,$P(X," ",1)_" " S X=$P(X," ",2,99)
  1.  E  W !,$P(X," ",1)," ",?8 S X=$P(X," ",2,999)
  1. P2 I $Y+5>IOSL K DIR S DIR(0)="E" D:'$D(ZTQUEUED) ^DIR:$E(IOST)="C"&$S('$D(XMP):1,'XMP:1,1:0) K DIR,DIRUT W @IOF I $D(DTOUT)!$D(DUOUT) S XMOUT=1 Q
  1.  I $G(XMP2(0))=1 W "=" K XMP2(0)
  1.  I $X+$L(X)+1<IOM!(IOM<22) W X Q
  1.  F J=(IOM-$X-1):-1:20 Q:"),@_:"[$E(X,J)  Q:J<20  I $E(X,J)?1P Q:$E(X,J-2)'=" "
  1.  W $E(X,1,J),!,?10 S X=$E(X,J+1,999)
  1.  G P2
  1.  ;
  1. XT S XMP2="T" G 1
  1.  ;
  1. XP S XMP2="P"
  1. 1 I $D(XMLOAD) W $C(7),!,"YOU CAN NOT PRINT a message while you are creating it." Q
  1.  S XCF=1 D MM,SP G SC
  1.  ;
  1. XR S XMP2="R" G 0
  1.  ;
  1. XI S XMP2="I"
  1. 0 D MM S XCF=2 G ENH^XMP2A
  1.  ;
  1. ENI D ^XMP3 G Q:X=U D S G Q:XMP2'="I"
  1.  I $D(XMINIT),$P(XMR,U,7)="X" D @XMINIT
  1.  I $D(XMINTEG) D @XMINTEG
  1. Q K XMA0,XMB0,XMP2,XMPASS,XMPKIDS,XMINIT,XMINTEG Q
  1.  ;
  1. XC S XCF=3,XMP2="C" D MM,SP G SC ; Compare Message (DOPT 9)
  1.  ;
  1. XS S XCF=0,XMP2="S" D MM,SP G SC
  1.  ;
  1. SP G DEV^XMPH ; Output where? Queued by default. AND !!!  Runs @XMP2 opt.
  1.  ;
  1. SC K XMP2 Q
  1.  ;
  1.  ;
  1.  ; From DEV+2^XMPH and ZTASK+4^XMPH only   for EVERYTHING!!!!  XMP2=What
  1. S S XCN=.999 G ENTR^XMP2A:XMP2="R",ENTT^XMP2A:XMP2="T" I '$D(XMR) S XMR=^XMB(3.9,XMZ,0)
  1.  F I=1:1 D NT Q:+XCN'=XCN  D:$E(X)="$" S1:X'["$TXT" Q:+XCN'=XCN  I $D(XMOUT) K XMOUT Q
  1.  Q
  1.  ;
  1. S1 Q:$E(X,1,5)="$END "!($E(X,1,5)'?1"$"3U1" ")
  1.  I XMP2="I",$P(XMR,U,7)["X",$E(X,1,9)'="$END ROU ",$E(X,1,5)'="$ROU " S XMOUT=1 Q
  1.  S T=$E(X,2,4),A=$T(@T) I A="" W $C(7),"Unknown identifier '",A,"'" K A Q
  1.  W:XCF=1 @IOF W !,"Line ",XCN,?10,"Message #"_XMZ,?29 W:XCF $P(",Unloading,Comparing,Verifying",",",XCF) W " ",$P(A,";;",2),"  ",$E(X,5,999)
  1.  I XCF=0 D:$E(A,1,3)="KID" K2 Q
  1.  S A=$P($T(@T+XCF),";;",2,999) I A=";" W !,"Not implemented yet" Q
  1.  I $E(X,1,4)="$ROU",'$D(XMINIT),XMP2="I" S %=$P(X," ",2) S:%?.1"^".AN1"INIT" XMINIT="^"_% I %?.1"^".AN1"NTEG" S XMINTEG="^"_%
  1.  X A K A Q
  1.  ;
  1. NT S XCN=$O(^XMB(3.9,XMZ,2,XCN)) Q:+XCN'=XCN  S X=^(XCN,0) D:$E(X)="$" CHECK^XMPSEC Q
  1.  ;
  1. MM S (DIE,DIF)="^XMB(3.9,XMZ,2," Q
  1.  ;
  1. G1 W !,X D NT Q:+XCN'=XCN  G P2
  1.  ;
  1. G2 W !,X D NT Q:+XCN'=XCN  S XMP2(0)=1 G P2
  1.  ;
  1. K1 ;print KIDS Distribution routines
  1.  F  S XCN=$O(^XMB(3.9,XMZ,2,XCN)) Q:+XCN'=XCN  S X=^(XCN,0) Q:$E(X)="$"  D:X?1"""RTN"","""1.8AN1""")"
  1.  .S XCN=XCN+1,X1=$E(X,1,$L(X)-1) W !,"Routine  ",$TR($P(X1,",",2),"""")
  1.  .F  S XCN=$O(^XMB(3.9,XMZ,2,XCN)) Q:+XCN'=XCN  S X=^(XCN,0) Q:$P(X,",",1,2)'=X1  S XCN=$O(^XMB(3.9,XMZ,2,XCN)),X=^(XCN,0) D P1 Q:$D(XMOUT)
  1.  .S:XCN=+XCN XCN=XCN-1
  1.  S XMOUT=1 Q
  1.  ;
  1. K2 ;print summary of KIDS Distribution
  1.  Q:$T(XMP2^XPDDP)=""  K ^TMP($J,"BLD"),M
  1.  F  S XCN=$O(^XMB(3.9,XMZ,2,XCN)) Q:+XCN'=XCN  S X=^(XCN,0) Q:$E(X)="$"  I X?1"""BLD"","1.N1",0)" S XCN=$O(^XMB(3.9,XMZ,2,XCN)),M=^(XCN,0) Q
  1.  Q:'$D(M)  S @("^TMP("_$J_","_X)=M,X1=$P(X,",",1,2)
  1.  F  S XCN=$O(^XMB(3.9,XMZ,2,XCN)) Q:+XCN'=XCN  S X=^(XCN,0) Q:$P(X,",",1,2)'=X1  S XCN=$O(^XMB(3.9,XMZ,2,XCN)),M=^(XCN,0),@("^TMP("_$J_","_X)=M
  1.  D XMP2^XPDDP("TMP("_$J_","_X1_")",$P(X1,",",2))
  1.  S XMOUT=1 Q
  1.  ;
  1. SAVE D NT Q:"$END "_T=$P(X," ",1,2)  S X1=X D NT Q:"$END "_T=$P(X," ",1,2)
  1.  ;I $A(X)=126 S %=X D NT S X=%_$E(X,2,999) ; Set by ^DIFROM1, but DIFROM is no longer used.
  1.  S @X1=$E(X,2-$G(XMP2(0)),999)
  1.  G SAVE
  1.  ;
  1. BEG S %=0,ROU=$E(X,6,99),^TMP("XMS",$J,ROU,0,1)="""" F %0=1:1 D NT Q:$E(X)="$"  S ^TMP("XMS",$J,ROU,0,%0)=X,%=%+$L(X)
  1.  S ^TMP("XMS",$J,ROU,0)=%,%0=%0-1 Q
  1.  ;
  1. COMP D NT Q:$E(X)="$"
  1.  S X1=X D NT Q:$E(X)="$"
  1.  ;
  1.  ;Globals
  1.  ;I $A(X)=126 S %=$E(X,2,999) D NT S X=%_$E(X,2,999) ; Set by ^DIFROM1, but DIFROM is no longer used.
  1.  I '$D(@X1) W !,"Node '",X1,"' not on disk." G COMP
  1.  S Y=@X1,B=$E(X,2-$G(XMP2(0)),999)
  1.  G COMP:Y=B
  1.  W !,"Node: ",X1,!,"Disk:    ",Y
  1.  W !,"Message: ",$E(X,2-$G(XMP2(0)),99)
  1.  S X=$E(X,2,999) F J=1:1:$L(X) Q:$E(X,J)'=$E(Y,J)
  1.  W !,?12+J,"^"
  1.  G COMP
  1.  ;
  1.  ;TAG ;;Description of type of PackMan Data
  1.  ;    ;;Executable Print Code
  1.  ;    ;;Executable Installation code
  1.  ;    ;;Executable Comparison to Installed
  1.  ;    ;;Executable Verification code
  1.  ;
  1. ROU ;;Routine
  1.  ;;S %1=1 D PP
  1.  ;;S X=$P(X," ",2) S:X="XMP2" X="XMP2Z" S DIE="^XMB(3.9,XMZ,2," X ^%ZOSF("SAVE") W:X="XMP2Z" !,$C(7),"CHANGE NAME OF ROUTINE XMP2Z TO XMP2"
  1.  ;;D LOAD^XMPC
  1.  ;;G BEG
  1. DDD ;;Data Dictionary
  1.  ;;S %1=2 D PP
  1.  ;;D SAVE
  1.  ;;D COMP
  1.  ;;
  1. OPT ;;Options
  1.  ;;S %1=2 D PP
  1.  ;;D SAVE
  1.  ;;Q
  1.  ;;
  1. HEL ;;Help Frames
  1.  ;;S %1=2 D PP
  1.  ;;D SAVE
  1.  ;;Q
  1.  ;;
  1. BUL ;;Bulletins
  1.  ;;S %1=2 D PP
  1.  ;;D SAVE
  1.  ;;Q
  1.  ;;
  1. KEY ;;Security keys
  1.  ;;S %1=2 D PP
  1.  ;;D SAVE
  1.  ;;Q
  1.  ;;
  1. FUN ;;Functions
  1.  ;;S %1=2 D PP
  1.  ;;D SAVE
  1.  ;;Q
  1.  ;;
  1. PKG ;;Package File
  1.  ;;S %1=2 D PP
  1.  ;;D SAVE
  1.  ;;Q
  1.  ;;
  1. RTN ;;Routine Documentation
  1.  ;;S %1=2 D PP
  1.  ;;D SAVE
  1.  ;;Q
  1.  ;;
  1. DIE ;;Input Templates
  1.  ;;S %1=2 D PP
  1.  ;;D SAVE
  1.  ;;Q
  1.  ;;
  1. DIP ;;Print Templates
  1.  ;;S %1=2 D PP
  1.  ;;D SAVE
  1.  ;;Q
  1.  ;;
  1. DIB ;;Sort Templates
  1.  ;;S %1=2 D PP
  1.  ;;D SAVE
  1.  ;;Q
  1.  ;;
  1. GLB ;;Global
  1.  ;;S %1=2 D PP
  1.  ;;D SAVE
  1.  ;;D COMP
  1.  ;;
  1. DTA ;;FileMan Data
  1.  ;;S %1=1 D PP
  1.  ;;D SAVE
  1.  ;;Q
  1.  ;;
  1. TXT ;;Text
  1.  ;;Q
  1.  ;;Q
  1.  ;;Q
  1.  ;;Q
  1. GLO ;;Global
  1.  ;;S %1=3 D PP
  1.  ;;S XMP2(0)=1 D SAVE K XMP2(0)
  1.  ;;S XMP2(0)=1 D COMP K XMP2(0)
  1.  ;;Q
  1. KID ;;KIDS Distribution
  1.  ;;S %1=4 D PP
  1.  ;;I $T(XMP2^XPDIPM)]"" D XMP2^XPDIPM
  1.  ;;;
  1.  ;;;