Return to DIWE3.m CVS log

Up to [Coherent Logic Development] / freem_fileman

Annotation of freem_fileman/DIWE3.m, revision 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