File:  [Coherent Logic Development] / freem_fileman / USER / DDSWP.m
Revision 1.1: download - view: text, annotated - select for diffs
Mon Apr 28 14:13:19 2025 UTC (3 months ago) by snw
Branches: MAIN
CVS tags: HEAD
Restructure repository

    1: DDSWP	;SFISC/MKO-WP ;10:49 AM  7 Oct 1994
    2: 	;;21.0;VA FileMan;;Dec 28, 1994
    3: 	;Per VHA Directive 10-93-142, this routine should not be modified.
    4: EDIT	;Edit the word processing field
    5: 	N I
    6: 	S DDSUE=$D(DDSTP)#2!$P($G(DDSO(4)),U,4)
    7: 	I DDSUE D  I $D(DIRUT) K DIRUT,DUOUT,DIROUT G EDITQ
    8: 	. D:DDM CLRMSG^DDS
    9: 	. K DIR S DIR(0)="E"
   10: 	. S DIR("A",1)="WARNING: This field is uneditable."
   11: 	. S DIR("A",2)="         Any changes made in the editor will not be saved."
   12: 	. S DIR("A",3)=""
   13: 	. S DIR("A")="Press RETURN to enter editor:"
   14: 	. S DIR0=IOSL-1_U_($L(DIR("A"))+1)_"^1^"_(IOSL-4)_"^0"
   15: 	. D ^DIR K DIR
   16: 	;
   17: 	S DDSUTL=$NA(@DDSREFT@("F"_DDP,DDSDA,DDSFLD))
   18: 	;
   19: 	I $D(@DDSUTL@("F"))[0,$D(@(DDSGL_"0)"))#2 D
   20: 	. K @DDSUTL@("D")
   21: 	. M @DDSUTL@("D")=@($E(DDSGL,1,$L(DDSGL)-1)_")")
   22: 	;
   23: 	S (DY,DX)=0 X IOXY W $P(DDGLCLR,DDGLDEL,2)
   24: 	S DIC=$E(DDSUTL,1,$L(DDSUTL)-1)_",""D"",",DWPK=1
   25: 	S DIWESUB=$P($G(DDSU("DD")),U) K:DIWESUB="" DIWESUB
   26: 	D EN^DIWE
   27: 	K DIC,DIWESUB,DWPK
   28: 	I 'DDSUE S DDSCHG=1,@DDSUTL@("F")=1
   29: 	E  K @DDSUTL@("D")
   30: EDITQ	K DDSUE,DDSUTL
   31: 	Q
   32: 	;
   33: WP	;At the wp field
   34: 	S DIR(0)="FO^0:0"
   35: 	S DIR("?")="^W ""Press 'RETURN' to edit this word processing field."""
   36: 	S DIR("??")="^D HELP^DDSWP"
   37: 	D ^DIR K DIR,DUOUT,DIRUT,DIROUT
   38: 	Q
   39: HELP	;?? help at the WP field
   40: 	S DDSFN=+$P(DDSU("M"),U,3)
   41: 	D:$G(^DD(DDSFN,.01,3))]"" MSG^DDSMSG(^(3))
   42: 	X:$G(^DD(DDSFN,.01,4))]"" ^(4)
   43: 	D:$D(^DD(DDSFN,.01,21)) WP^DDSMSG("^DD("_DDSFN_",.01,21)")
   44: 	K DDSFN
   45: 	Q

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>