- XMPC ;(WASH ISC)/THM/CAP-PackMan Compare ;12/04/2002 13:48
- ;;8.0;MailMan;**10**;Jun 28, 2002
- S S="",%2="",C=IOM-2/2\1,(M,B)=0,H=3
- D S M=M+1,B=B+1 G:M>O!(B>F) WRI G:^TMP($J,1,M,0)=^TMP($J,2,B,0) D S W=^TMP($J,1,M,0),(%4,%3)=""
- F I=B:1:$S(B+5<F:B+5,1:F) S V=^TMP($J,2,I,0) D DDD G D:%4="EQUAL"
- S Z=1,G=M D HEAD:'$D(%2) D WP S B=B-1 G D
- DDD F K=1:5:26 Q:$L($E(V,K,K+10))<7 I $F(W,$E(V,K,K+10)) S %3="MPART" G E1
- Q
- E1 D HEAD G MAT:%3="MPART"!(%4="EQUAL") S Z=1,G=M D WP S B=B-1,%4="EQUAL" Q
- MAT S Q=1 F J=B:1:I-1 S X=^TMP($J,2,J,0),Z=1,G=J D WF1
- S B=B+(I-B) S:W=V %4="EQUAL" Q:%4="EQUAL"
- S %4=W,%3=^TMP($J,2,B,0),Q=0,Z=1,L=0
- F K=1:1 S X=$E(%4,1,C-5) S:K=1 G=M D WP1 S Y=X,X=$E(%3,1,C-5) S:K=1 G=B,Z=1 D WF1 S %4=$E(%4,C-4,255),%3=$E(%3,C-4,255) D:X'=Y&$D(S)&(L=0) S I '$L(%3)&('$L(%4)) S %4="EQUAL" Q
- Q
- WRI I M>O&(B<(F+1)) F I=B:1:F S X=^TMP($J,2,I,0),Q=1,Z=1,G=I D WF1
- I B>F&(M<(O+1)) F I=M:1:O S X=^TMP($J,1,I,0),Z=1,G=I D WP1
- K %,%0,%1,%2,%3,%4,B,C,D,F,G,H,J,K,L,M,N,O,P,Q,R,S,T,V,W,X,Z
- W W !,"-----------------------------------------------------------------------------"
- Q
- WP S X=W
- WP1 W ! Q:'$L(X) W " ",$S(Z:$J(G,2),1:" "),"{",$E(X,1,C-5),$C(125) S Z=0 Q:$L(X)<(C-4) S X=$E(X,C-4,255) G WP1
- WF1 W:Q=1 ! Q:'$L(X) W ?C+2 W $S(Z:$J(G,2),1:" "),"{",$E(X,1,C-5),$C(125) S Z=0 Q:$L(X)<(C-4) S X=$E(X,C-4,255) G WF1
- HEAD S:H=2 H=0 Q:H'=0 W !,P," (",IOD,")",?C+1,P," (",E,")" S H=1 Q
- S F L=1:1:$L(X) G:$E(X,L)'=$E(Y,L) S1
- S1 W !?L+3,"^",?L+C+4,"^" Q
- LOAD K ^TMP($J,1),^TMP($J,2) S (X,R)=$P(X," ",2) S:X[U (X,R)=$P(R,U,2) I '$D(^%ZOSF("TEST")) W !,"Routine compare not available. " Q
- X ^%ZOSF("TEST") I '$T W !,"Routine ",R," missing from disk." G W
- S DIF="^TMP($J,1,",XCNP=0,X=R X ^%ZOSF("LOAD") S O=XCNP
- L3 F F=0:0 D NT Q:+XCN'=XCN!($E(X,1,4)["$END") I $E(X)'="$" S F=F+1,^TMP($J,2,F,0)=X
- S O=O-1 G XMPC
- NT S XCN=$O(@(DIE_XCN_")")) Q:+XCN'=XCN S X=^(XCN,0) Q
- COMP ;COMPARE MESSAGE X TO MESSAGE Y
- S J=.999
- C1 S J=$O(^XMB(3.9,X,2,J)) Q:J="" G C1:^(J,0)=^XMB(3.9,Y,2,J,0)
- W !,"NOT THE SAME" Q
- TOP ;W @IOF,!,"MailMan PackMan Compare - For "_XMDUN
- I '$D(XMR) S XMR=^XMB(3.9,XMZ,0)
- I $E($G(IOST),1,2)'="C-" D
- . W "MailMan PackMan Compare - For ",XMV("NAME")
- . W !,"Message #"_XMZ,!,"Subject: "_$P(XMR,U),!,"From: "_$$NAME^XMXUTIL($P(XMR,U,2))
- . D NOW^%DTC S XMA=%,X=% D DW^%DTC W !,X," " S Y=XMA D DD^%DT
- . W Y X ^%ZOSF("UCI") W " ("_Y_")",!
- S I="",$P(I,"*",81)=""
- W !,I,!,"Message #"_XMZ_" Routine from DISK on LEFT - from Message on RIGHT",!,I,!
- K %H,%T,%Y,%,XMA
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HXMPC 2547 printed Feb 18, 2025@23:38:57 Page 2
- XMPC ;(WASH ISC)/THM/CAP-PackMan Compare ;12/04/2002 13:48
- +1 ;;8.0;MailMan;**10**;Jun 28, 2002
- +2 SET S=""
- SET %2=""
- SET C=IOM-2/2\1
- SET (M,B)=0
- SET H=3
- D SET M=M+1
- SET B=B+1
- if M>O!(B>F)
- GOTO WRI
- if ^TMP($JOB,1,M,0)=^TMP($JOB,2,B,0)
- GOTO D
- SET W=^TMP($JOB,1,M,0)
- SET (%4,%3)=""
- +1 FOR I=B:1:$SELECT(B+5<F:B+5,1:F)
- SET V=^TMP($JOB,2,I,0)
- DO DDD
- if %4="EQUAL"
- GOTO D
- +2 SET Z=1
- SET G=M
- if '$DATA(%2)
- DO HEAD
- DO WP
- SET B=B-1
- GOTO D
- DDD FOR K=1:5:26
- if $LENGTH($EXTRACT(V,K,K+10))<7
- QUIT
- IF $FIND(W,$EXTRACT(V,K,K+10))
- SET %3="MPART"
- GOTO E1
- +1 QUIT
- E1 DO HEAD
- if %3="MPART"!(%4="EQUAL")
- GOTO MAT
- SET Z=1
- SET G=M
- DO WP
- SET B=B-1
- SET %4="EQUAL"
- QUIT
- MAT SET Q=1
- FOR J=B:1:I-1
- SET X=^TMP($JOB,2,J,0)
- SET Z=1
- SET G=J
- DO WF1
- +1 SET B=B+(I-B)
- if W=V
- SET %4="EQUAL"
- if %4="EQUAL"
- QUIT
- +2 SET %4=W
- SET %3=^TMP($JOB,2,B,0)
- SET Q=0
- SET Z=1
- SET L=0
- +3 FOR K=1:1
- SET X=$EXTRACT(%4,1,C-5)
- if K=1
- SET G=M
- DO WP1
- SET Y=X
- SET X=$EXTRACT(%3,1,C-5)
- if K=1
- SET G=B
- SET Z=1
- DO WF1
- SET %4=$EXTRACT(%4,C-4,255)
- SET %3=$EXTRACT(%3,C-4,255)
- if X'=Y&$DATA(S)&(L=0)
- DO S
- IF '$LENGTH(%3)&('$LENGTH(%4))
- SET %4="EQUAL"
- QUIT
- +4 QUIT
- WRI IF M>O&(B<(F+1))
- FOR I=B:1:F
- SET X=^TMP($JOB,2,I,0)
- SET Q=1
- SET Z=1
- SET G=I
- DO WF1
- +1 IF B>F&(M<(O+1))
- FOR I=M:1:O
- SET X=^TMP($JOB,1,I,0)
- SET Z=1
- SET G=I
- DO WP1
- +2 KILL %,%0,%1,%2,%3,%4,B,C,D,F,G,H,J,K,L,M,N,O,P,Q,R,S,T,V,W,X,Z
- W WRITE !,"-----------------------------------------------------------------------------"
- +1 QUIT
- WP SET X=W
- WP1 WRITE !
- if '$LENGTH(X)
- QUIT
- WRITE " ",$SELECT(Z:$JUSTIFY(G,2),1:" "),"{",$EXTRACT(X,1,C-5),$CHAR(125)
- SET Z=0
- if $LENGTH(X)<(C-4)
- QUIT
- SET X=$EXTRACT(X,C-4,255)
- GOTO WP1
- WF1 if Q=1
- WRITE !
- if '$LENGTH(X)
- QUIT
- WRITE ?C+2
- WRITE $SELECT(Z:$JUSTIFY(G,2),1:" "),"{",$EXTRACT(X,1,C-5),$CHAR(125)
- SET Z=0
- if $LENGTH(X)<(C-4)
- QUIT
- SET X=$EXTRACT(X,C-4,255)
- GOTO WF1
- HEAD if H=2
- SET H=0
- if H'=0
- QUIT
- WRITE !,P," (",IOD,")",?C+1,P," (",E,")"
- SET H=1
- QUIT
- S FOR L=1:1:$LENGTH(X)
- if $EXTRACT(X,L)'=$EXTRACT(Y,L)
- GOTO S1
- S1 WRITE !?L+3,"^",?L+C+4,"^"
- QUIT
- LOAD KILL ^TMP($JOB,1),^TMP($JOB,2)
- SET (X,R)=$PIECE(X," ",2)
- if X[U
- SET (X,R)=$PIECE(R,U,2)
- IF '$DATA(^%ZOSF("TEST"))
- WRITE !,"Routine compare not available. "
- QUIT
- +1 XECUTE ^%ZOSF("TEST")
- IF '$TEST
- WRITE !,"Routine ",R," missing from disk."
- GOTO W
- +2 SET DIF="^TMP($J,1,"
- SET XCNP=0
- SET X=R
- XECUTE ^%ZOSF("LOAD")
- SET O=XCNP
- L3 FOR F=0:0
- DO NT
- if +XCN'=XCN!($EXTRACT(X,1,4)["$END")
- QUIT
- IF $EXTRACT(X)'="$"
- SET F=F+1
- SET ^TMP($JOB,2,F,0)=X
- +1 SET O=O-1
- GOTO XMPC
- NT SET XCN=$ORDER(@(DIE_XCN_")"))
- if +XCN'=XCN
- QUIT
- SET X=^(XCN,0)
- QUIT
- COMP ;COMPARE MESSAGE X TO MESSAGE Y
- +1 SET J=.999
- C1 SET J=$ORDER(^XMB(3.9,X,2,J))
- if J=""
- QUIT
- if ^(J,0)=^XMB(3.9,Y,2,J,0)
- GOTO C1
- +1 WRITE !,"NOT THE SAME"
- QUIT
- TOP ;W @IOF,!,"MailMan PackMan Compare - For "_XMDUN
- +1 IF '$DATA(XMR)
- SET XMR=^XMB(3.9,XMZ,0)
- +2 IF $EXTRACT($GET(IOST),1,2)'="C-"
- Begin DoDot:1
- +3 WRITE "MailMan PackMan Compare - For ",XMV("NAME")
- +4 WRITE !,"Message #"_XMZ,!,"Subject: "_$PIECE(XMR,U),!,"From: "_$$NAME^XMXUTIL($PIECE(XMR,U,2))
- +5 DO NOW^%DTC
- SET XMA=%
- SET X=%
- DO DW^%DTC
- WRITE !,X," "
- SET Y=XMA
- DO DD^%DT
- +6 WRITE Y
- XECUTE ^%ZOSF("UCI")
- WRITE " ("_Y_")",!
- End DoDot:1
- +7 SET I=""
- SET $PIECE(I,"*",81)=""
- +8 WRITE !,I,!,"Message #"_XMZ_" Routine from DISK on LEFT - from Message on RIGHT",!,I,!
- +9 KILL %H,%T,%Y,%,XMA
- +10 QUIT