source: FOIAVistA/trunk/r/MAILMAN-XM/XMP2.m@ 1119

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

initial load of FOIAVistA 6/30/08 version

File size: 5.5 KB
Line 
1XMP2 ;(WASH ISC)/GM/CAP-PackMan Print/Install/Summarize/Compare ;04/17/2002 11:07
2 ;;8.0;MailMan;;Jun 28, 2002
3 ; Entry points used by MailMan options (not covered by DBIA):
4 ; XC XMPCOM - Compare message
5 ; XI XMPINS - Install message
6 ; XP XMPPRT - Print message
7 ; XS XMPSUM - Summarize message
8 ;;XMP2 IS INSTALLED AS XMP2Z TO AVOID CLOBBER ERRORS / FILE AS XMP2
9 Q
10 ;
11LIST ;LIST MESSAGE
12 S XCN=.999 F M=1:1 D NT Q:+XCN'=XCN W !,X
13 Q
14 ;
15 ;
16PP ;PRETTY PRINT
17 S:'$D(XCN) XCN=.999 S XCN=+XCN K XMOUT
18 F I=1:1 D NT Q:XCN'=+XCN Q:$E(X)="$" D @($P("P1,G1,G2,K1",",",%1)) Q:$D(XMOUT)
19 Q
20 ;
21P1 Q:X?1"KEY ;;;".E
22 I XMP2="T" W !,$P(X," ",1)_" " S X=$P(X," ",2,99)
23 E W !,$P(X," ",1)," ",?8 S X=$P(X," ",2,999)
24P2 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
25 I $G(XMP2(0))=1 W "=" K XMP2(0)
26 I $X+$L(X)+1<IOM!(IOM<22) W X Q
27 F J=(IOM-$X-1):-1:20 Q:"),@_:"[$E(X,J) Q:J<20 I $E(X,J)?1P Q:$E(X,J-2)'=" "
28 W $E(X,1,J),!,?10 S X=$E(X,J+1,999)
29 G P2
30 ;
31XT S XMP2="T" G 1
32 ;
33XP S XMP2="P"
341 I $D(XMLOAD) W $C(7),!,"YOU CAN NOT PRINT a message while you are creating it." Q
35 S XCF=1 D MM,SP G SC
36 ;
37XR S XMP2="R" G 0
38 ;
39XI S XMP2="I"
400 D MM S XCF=2 G ENH^XMP2A
41 ;
42ENI D ^XMP3 G Q:X=U D S G Q:XMP2'="I"
43 I $D(XMINIT),$P(XMR,U,7)="X" D @XMINIT
44 I $D(XMINTEG) D @XMINTEG
45Q K XMA0,XMB0,XMP2,XMPASS,XMPKIDS,XMINIT,XMINTEG Q
46 ;
47XC S XCF=3,XMP2="C" D MM,SP G SC ; Compare Message (DOPT 9)
48 ;
49XS S XCF=0,XMP2="S" D MM,SP G SC
50 ;
51SP G DEV^XMPH ; Output where? Queued by default. AND !!! Runs @XMP2 opt.
52 ;
53SC K XMP2 Q
54 ;
55 ;
56 ; From DEV+2^XMPH and ZTASK+4^XMPH only for EVERYTHING!!!! XMP2=What
57S S XCN=.999 G ENTR^XMP2A:XMP2="R",ENTT^XMP2A:XMP2="T" I '$D(XMR) S XMR=^XMB(3.9,XMZ,0)
58 F I=1:1 D NT Q:+XCN'=XCN D:$E(X)="$" S1:X'["$TXT" Q:+XCN'=XCN I $D(XMOUT) K XMOUT Q
59 Q
60 ;
61S1 Q:$E(X,1,5)="$END "!($E(X,1,5)'?1"$"3U1" ")
62 I XMP2="I",$P(XMR,U,7)["X",$E(X,1,9)'="$END ROU ",$E(X,1,5)'="$ROU " S XMOUT=1 Q
63 S T=$E(X,2,4),A=$T(@T) I A="" W $C(7),"Unknown identifier '",A,"'" K A Q
64 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)
65 I XCF=0 D:$E(A,1,3)="KID" K2 Q
66 S A=$P($T(@T+XCF),";;",2,999) I A=";" W !,"Not implemented yet" Q
67 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="^"_%
68 X A K A Q
69 ;
70NT S XCN=$O(^XMB(3.9,XMZ,2,XCN)) Q:+XCN'=XCN S X=^(XCN,0) D:$E(X)="$" CHECK^XMPSEC Q
71 ;
72MM S (DIE,DIF)="^XMB(3.9,XMZ,2," Q
73 ;
74G1 W !,X D NT Q:+XCN'=XCN G P2
75 ;
76G2 W !,X D NT Q:+XCN'=XCN S XMP2(0)=1 G P2
77 ;
78K1 ;print KIDS Distribution routines
79 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""")"
80 .S XCN=XCN+1,X1=$E(X,1,$L(X)-1) W !,"Routine ",$TR($P(X1,",",2),"""")
81 .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)
82 .S:XCN=+XCN XCN=XCN-1
83 S XMOUT=1 Q
84 ;
85K2 ;print summary of KIDS Distribution
86 Q:$T(XMP2^XPDDP)="" K ^TMP($J,"BLD"),M
87 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
88 Q:'$D(M) S @("^TMP("_$J_","_X)=M,X1=$P(X,",",1,2)
89 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
90 D XMP2^XPDDP("TMP("_$J_","_X1_")",$P(X1,",",2))
91 S XMOUT=1 Q
92 ;
93SAVE D NT Q:"$END "_T=$P(X," ",1,2) S X1=X D NT Q:"$END "_T=$P(X," ",1,2)
94 ;I $A(X)=126 S %=X D NT S X=%_$E(X,2,999) ; Set by ^DIFROM1, but DIFROM is no longer used.
95 S @X1=$E(X,2-$G(XMP2(0)),999)
96 G SAVE
97 ;
98BEG 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)
99 S ^TMP("XMS",$J,ROU,0)=%,%0=%0-1 Q
100 ;
101COMP D NT Q:$E(X)="$"
102 S X1=X D NT Q:$E(X)="$"
103 ;
104 ;Globals
105 ;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.
106 I '$D(@X1) W !,"Node '",X1,"' not on disk." G COMP
107 S Y=@X1,B=$E(X,2-$G(XMP2(0)),999)
108 G COMP:Y=B
109 W !,"Node: ",X1,!,"Disk: ",Y
110 W !,"Message: ",$E(X,2-$G(XMP2(0)),99)
111 S X=$E(X,2,999) F J=1:1:$L(X) Q:$E(X,J)'=$E(Y,J)
112 W !,?12+J,"^"
113 G COMP
114 ;
115 ;TAG ;;Description of type of PackMan Data
116 ; ;;Executable Print Code
117 ; ;;Executable Installation code
118 ; ;;Executable Comparison to Installed
119 ; ;;Executable Verification code
120 ;
121ROU ;;Routine
122 ;;S %1=1 D PP
123 ;;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"
124 ;;D LOAD^XMPC
125 ;;G BEG
126DDD ;;Data Dictionary
127 ;;S %1=2 D PP
128 ;;D SAVE
129 ;;D COMP
130 ;;
131OPT ;;Options
132 ;;S %1=2 D PP
133 ;;D SAVE
134 ;;Q
135 ;;
136HEL ;;Help Frames
137 ;;S %1=2 D PP
138 ;;D SAVE
139 ;;Q
140 ;;
141BUL ;;Bulletins
142 ;;S %1=2 D PP
143 ;;D SAVE
144 ;;Q
145 ;;
146KEY ;;Security keys
147 ;;S %1=2 D PP
148 ;;D SAVE
149 ;;Q
150 ;;
151FUN ;;Functions
152 ;;S %1=2 D PP
153 ;;D SAVE
154 ;;Q
155 ;;
156PKG ;;Package File
157 ;;S %1=2 D PP
158 ;;D SAVE
159 ;;Q
160 ;;
161RTN ;;Routine Documentation
162 ;;S %1=2 D PP
163 ;;D SAVE
164 ;;Q
165 ;;
166DIE ;;Input Templates
167 ;;S %1=2 D PP
168 ;;D SAVE
169 ;;Q
170 ;;
171DIP ;;Print Templates
172 ;;S %1=2 D PP
173 ;;D SAVE
174 ;;Q
175 ;;
176DIB ;;Sort Templates
177 ;;S %1=2 D PP
178 ;;D SAVE
179 ;;Q
180 ;;
181GLB ;;Global
182 ;;S %1=2 D PP
183 ;;D SAVE
184 ;;D COMP
185 ;;
186DTA ;;FileMan Data
187 ;;S %1=1 D PP
188 ;;D SAVE
189 ;;Q
190 ;;
191TXT ;;Text
192 ;;Q
193 ;;Q
194 ;;Q
195 ;;Q
196GLO ;;Global
197 ;;S %1=3 D PP
198 ;;S XMP2(0)=1 D SAVE K XMP2(0)
199 ;;S XMP2(0)=1 D COMP K XMP2(0)
200 ;;Q
201KID ;;KIDS Distribution
202 ;;S %1=4 D PP
203 ;;I $T(XMP2^XPDIPM)]"" D XMP2^XPDIPM
204 ;;;
205 ;;;
Note: See TracBrowser for help on using the repository browser.