Return to DIWE3.m CVS log

Up to [Coherent Logic Development] / freem_fileman / USER

Restructure repository

    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