Return to DIWE3.m CVS log

Up to [Coherent Logic Development] / freem_fileman

Annotation of freem_fileman/DIWE3.m, revision 1.1.1.1

1.1       snw         1: DIWE3  ;SFISC/GFT-WP - MOVE, DELETE, REPEAT, TRANSFER ;8/3/94  1:36 PM
                      2:        ;;21.0;VA FileMan;;Dec 28, 1994
                      3:        ;Per VHA Directive 10-93-142, this routine should not be modified.
                      4: M      ;MOVE
                      5:        S DWAFT=1 G 1:X=U,OPT:'X S (DW1,DW3)=0 D MOVE Q:$D(DTOUT)  S:DW1>DW3 DW1=DW1+I,DW2=DW2+I D DEL:DW1
                      6: 1      G ^DIWE1
                      7:        ;
                      8: OPT    W ! G OPT^DIWE1
                      9:        ;
                     10: R      ;REPEAT
                     11:        S DWAFT=1 G 1:X=U,OPT:'X D MOVE
                     12:        G 1
                     13:        ;
                     14: D      ;DELETE
                     15:        S DW1=X G 1:X=U,OPT:'X W "  thru: "_DW1_"// " R DW2:DTIME S:'$T DTOUT=1
                     16:        G 1:DW2=U!'$T S:DW2="" DW2=DW1 I DW1>DW2 W $C(7),"??" G OPT
                     17:        I DW2>DWLC S DW2=DWLC W "  ("_DW2_")"
                     18:        S X=DW2-DW1+1,%=2 W !,"OK TO REMOVE "_X_" LINE"_$E("S",X>1)
                     19:        D YN^DICN I %-1 W "  <NOTHING DELETED>" G 1
                     20:        S %=2 I DW1=1,DW2=DWLC W !,$C(7),"ARE YOU SURE YOU WANT TO DELETE THIS ENTIRE TEXT" D YN^DICN G 1:%-1
                     21:        D DEL K DWL G 1
                     22:        ;
                     23: F      R !,"From line: ",DWL:DTIME S:'$T DTOUT=1 G Q:DWL=U!'$T
                     24:        I DWL?."?" D H^DIWE5 G F
                     25:        I +DWL'=DWL W $C(7)," ??    Please enter a number." G F
                     26: MOVE   R "  thru: ",DW2:DTIME S:'$T DTOUT=1 G Q:DW2=U!'$T S DW1=DWL
                     27:        I $E(DW2)="E"!($E(DW2)="e") S DW2=9999999
                     28:        I 'DW2 S DW2=DW1 W " (",DW1,")"
                     29:        S %=2 G YN:'DWAFT R " after line: ",DW3:DTIME S:'$T DTOUT=1 G Q:DW3=U!'$T
                     30:        I DW1-1<DW3,DW2>DW3 G Q
                     31:        I DW1<1!(DW2>DWLC)!(DW1>DW2)!(DW3<0)!(DW3>DWLC)!(+DW3'=DW3) G Q
                     32: YN     W !,"ARE YOU SURE" D YN^DICN
                     33:        G Q:%-1 K ^UTILITY($J,"W") S I=0
                     34:        I DWAFT?.N X "S J=DW1-.1 F  S J=$O("_DIC_"J)) Q:J>DW2!(J'>0)  I $D(^(J,0)) S X=^(0) D O" S:J="" J=-1 G DN
                     35:        S DICMX=DWAFT X X S DIC=DWI
                     36: DN     G Q:'I X "F J=DWLC:-1:DW3+1 S "_DIC_"J+I,0)="_DIC_"J,0)","F J=1:1:I S "_DIC_"DW3+J,0)=^UTILITY($J,""W"",J,0) W ""."""
                     37:        K ^UTILITY($J,"W"),DWL,X,DICMX S DWLC=DWLC+I,@(DIC_"0)")=DWLC Q
                     38:        ;
                     39: DEL    S I=+DW1
                     40:        X "F J=DW2+1:1:DWLC S "_DIC_"I,0)="_DIC_"J,0),I=I+1 W ""."""
                     41:        S I=DW2-DW1
                     42:        X "F J=DWLC-I:1:DWLC K "_DIC_"J) W ""."""
                     43:        S DWLC=DWLC-I-1 Q
                     44:        ;
                     45: Z      ;
                     46:        Q:X=""  S DWAFT=0,DW3=X Q:X[U!(X>DWLC)  I '$D(DIA("P")) G Q
                     47:        R !,"From what text: ",X:DTIME S:'$T DTOUT=1 G Q:U[X
                     48:        I X?1."?" D  G Z
                     49:        .N X,Y,D,DIC,DIR,DZ,DIX,DIY,DIZ,DO,DD
                     50:        .W !! I DIA("P")=3.9 W ?5,"Enter the message number or SUBJECT of another mailman message, OR"
                     51:        .I DIA("P")'=3.9 W ?5,"Select another entry in this file OR"
                     52:        .W !?5,"use relational syntax to pick up information from a word-processing",!?5,"field in another file.",!
                     53:        .W ?5,"ex.  ""VALUE"":FILE NAME:WORD PROCESSING FIELD NAME",!
                     54:        .W !,"Do you want the entire "_$O(^DD(DIA("P"),0,"NM",0))_" list?"
                     55:        .S DZ="??" S DIR(0)="Y" D ^DIR Q:'Y
                     56:        .S DIC=$S(DIA("P")=3.9:"^XMB(3.9,",1:DIE),DIC(0)="QEM",D="B" D DQ^DICQ
                     57:        .Q
                     58:        I DIA("P")=3.9 S:X?1.N X="`"_X S DP=DIA("P"),DC="1^3.92A",DIE="^XMB(3.9,"
                     59:        K I,J S DWI=DIC,DWAFT=$S($D(DA)#2:DA,1:0)
                     60:        S DICMX="D O:D'<DW1&(D'>DW2) K:D>DW2 D",DQI="Y(",DA="X(",I(0)=DIA
                     61:        S J(0)=DIA("P"),DICOMP="?" I X?1"`"1N.N I $D(@(DIE_+$P(X,"`",2)_",0)")) S DWAFT(2)=X,X=$P(^(0),U,1)
                     62:        I X?.ANP S @("I=$O("_DIE_"""B"",$E(X,1,30)))") S:I="" I=-1 I $P(I,$E(X,1,30))=""!$D(^($E(X,1,30)))!(X?1."?") S X=""""_X_""":"_$O(^DD(DP,0,"NM",0))_":"_$O(^DD(+$P(DC,U,2),0,"NM",0))
                     63:        D DICOMP
                     64:        S DIC=DWI,DA=DWAFT,DWAFT=U I '$D(X) G Q
                     65:        I $G(Y)'["w" D  I $G(DIRUT) K DIRUT G Q
                     66:        .W $C(7),!!,"WARNING!",!,"The field you are transferring text from displays text without wrapping."
                     67:        .W !,"The field you are transferring text into may display text differently."
                     68:        .W !!,"Do you want to continue?",! N X,Y,DIR S DIR(0)="Y" D ^DIR
                     69:        .W ! S:'Y DIRUT=1
                     70:        G Q:X'["D ^DIC" D  I Y<0 K DWAFT S DIC=DWI G Z:X?1."?",Q
                     71:        .S %=$F(X,"D ^DIC"),%=$F(X," ",%)-1,DWAFT=$E(X,1,$F(X,"S X=")-6),DWAFT(1)=$E(X,%,999)
                     72:        .X $P(X," D ^DIC") S DIC(0)="QEM" S:$G(DWAFT(2))]"" X=DWAFT(2) D ^DIC
                     73:        I DIC["^XMB(3.9,",$D(XMZ) S DIXM=XMZ X "N X D XM" K DIXM
                     74:        S DIC=DWI I X'[U S X=DWAFT_" S Y="_+Y_DWAFT(1) K DWAFT S DWAFT=U G F
                     75: Q      W "  <NO CHANGE>",$C(7) S DW1=0 K DWL,X,DICMX,DWAFT Q
                     76: O      S I=I+1,^UTILITY($J,"W",I,0)=X Q
                     77:        ;
                     78: DICOMP I DIA("P")=3.9 S %=DUZ N DUZ S DUZ=%,DUZ(0)="@"
                     79:        D ^DICOMP Q
                     80:        ;
                     81: XM     W !,"Transfer from Response: Original Message// " R X:DTIME Q:X[U
                     82:        I X?1."?" S XMZ=+Y D ENT8^XMAH S Y=XMZ,XMZ=DIXM G XM
                     83:        I X,$D(^XMB(3.9,+Y,3,X,0)) S Y=+^(0) Q
                     84:        I X=""!(X=0)!(X="O") Q
                     85:        G XM