Return to DIWE3.m CVS log

Up to [Coherent Logic Development] / freem_fileman / USER

Restructure repository

DIWE3	;SFISC/GFT-WP - MOVE, DELETE, REPEAT, TRANSFER ;8/3/94  1:36 PM
	;;21.0;VA FileMan;;Dec 28, 1994
	;Per VHA Directive 10-93-142, this routine should not be modified.
M	;MOVE
	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
1	G ^DIWE1
	;
OPT	W ! G OPT^DIWE1
	;
R	;REPEAT
	S DWAFT=1 G 1:X=U,OPT:'X D MOVE
	G 1
	;
D	;DELETE
	S DW1=X G 1:X=U,OPT:'X W "  thru: "_DW1_"// " R DW2:DTIME S:'$T DTOUT=1
	G 1:DW2=U!'$T S:DW2="" DW2=DW1 I DW1>DW2 W $C(7),"??" G OPT
	I DW2>DWLC S DW2=DWLC W "  ("_DW2_")"
	S X=DW2-DW1+1,%=2 W !,"OK TO REMOVE "_X_" LINE"_$E("S",X>1)
	D YN^DICN I %-1 W "  <NOTHING DELETED>" G 1
	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
	D DEL K DWL G 1
	;
F	R !,"From line: ",DWL:DTIME S:'$T DTOUT=1 G Q:DWL=U!'$T
	I DWL?."?" D H^DIWE5 G F
	I +DWL'=DWL W $C(7)," ??    Please enter a number." G F
MOVE	R "  thru: ",DW2:DTIME S:'$T DTOUT=1 G Q:DW2=U!'$T S DW1=DWL
	I $E(DW2)="E"!($E(DW2)="e") S DW2=9999999
	I 'DW2 S DW2=DW1 W " (",DW1,")"
	S %=2 G YN:'DWAFT R " after line: ",DW3:DTIME S:'$T DTOUT=1 G Q:DW3=U!'$T
	I DW1-1<DW3,DW2>DW3 G Q
	I DW1<1!(DW2>DWLC)!(DW1>DW2)!(DW3<0)!(DW3>DWLC)!(+DW3'=DW3) G Q
YN	W !,"ARE YOU SURE" D YN^DICN
	G Q:%-1 K ^UTILITY($J,"W") S I=0
	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
	S DICMX=DWAFT X X S DIC=DWI
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 ""."""
	K ^UTILITY($J,"W"),DWL,X,DICMX S DWLC=DWLC+I,@(DIC_"0)")=DWLC Q
	;
DEL	S I=+DW1
	X "F J=DW2+1:1:DWLC S "_DIC_"I,0)="_DIC_"J,0),I=I+1 W ""."""
	S I=DW2-DW1
	X "F J=DWLC-I:1:DWLC K "_DIC_"J) W ""."""
	S DWLC=DWLC-I-1 Q
	;
Z	;
	Q:X=""  S DWAFT=0,DW3=X Q:X[U!(X>DWLC)  I '$D(DIA("P")) G Q
	R !,"From what text: ",X:DTIME S:'$T DTOUT=1 G Q:U[X
	I X?1."?" D  G Z
	.N X,Y,D,DIC,DIR,DZ,DIX,DIY,DIZ,DO,DD
	.W !! I DIA("P")=3.9 W ?5,"Enter the message number or SUBJECT of another mailman message, OR"
	.I DIA("P")'=3.9 W ?5,"Select another entry in this file OR"
	.W !?5,"use relational syntax to pick up information from a word-processing",!?5,"field in another file.",!
	.W ?5,"ex.  ""VALUE"":FILE NAME:WORD PROCESSING FIELD NAME",!
	.W !,"Do you want the entire "_$O(^DD(DIA("P"),0,"NM",0))_" list?"
	.S DZ="??" S DIR(0)="Y" D ^DIR Q:'Y
	.S DIC=$S(DIA("P")=3.9:"^XMB(3.9,",1:DIE),DIC(0)="QEM",D="B" D DQ^DICQ
	.Q
	I DIA("P")=3.9 S:X?1.N X="`"_X S DP=DIA("P"),DC="1^3.92A",DIE="^XMB(3.9,"
	K I,J S DWI=DIC,DWAFT=$S($D(DA)#2:DA,1:0)
	S DICMX="D O:D'<DW1&(D'>DW2) K:D>DW2 D",DQI="Y(",DA="X(",I(0)=DIA
	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)
	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))
	D DICOMP
	S DIC=DWI,DA=DWAFT,DWAFT=U I '$D(X) G Q
	I $G(Y)'["w" D  I $G(DIRUT) K DIRUT G Q
	.W $C(7),!!,"WARNING!",!,"The field you are transferring text from displays text without wrapping."
	.W !,"The field you are transferring text into may display text differently."
	.W !!,"Do you want to continue?",! N X,Y,DIR S DIR(0)="Y" D ^DIR
	.W ! S:'Y DIRUT=1
	G Q:X'["D ^DIC" D  I Y<0 K DWAFT S DIC=DWI G Z:X?1."?",Q
	.S %=$F(X,"D ^DIC"),%=$F(X," ",%)-1,DWAFT=$E(X,1,$F(X,"S X=")-6),DWAFT(1)=$E(X,%,999)
	.X $P(X," D ^DIC") S DIC(0)="QEM" S:$G(DWAFT(2))]"" X=DWAFT(2) D ^DIC
	I DIC["^XMB(3.9,",$D(XMZ) S DIXM=XMZ X "N X D XM" K DIXM
	S DIC=DWI I X'[U S X=DWAFT_" S Y="_+Y_DWAFT(1) K DWAFT S DWAFT=U G F
Q	W "  <NO CHANGE>",$C(7) S DW1=0 K DWL,X,DICMX,DWAFT Q
O	S I=I+1,^UTILITY($J,"W",I,0)=X Q
	;
DICOMP	I DIA("P")=3.9 S %=DUZ N DUZ S DUZ=%,DUZ(0)="@"
	D ^DICOMP Q
	;
XM	W !,"Transfer from Response: Original Message// " R X:DTIME Q:X[U
	I X?1."?" S XMZ=+Y D ENT8^XMAH S Y=XMZ,XMZ=DIXM G XM
	I X,$D(^XMB(3.9,+Y,3,X,0)) S Y=+^(0) Q
	I X=""!(X=0)!(X="O") Q
	G XM