source: WorldVistAEHR/trunk/r/VA_FILEMAN-ARJT-DI-DD-DM-DT-%DT-%RCR/DDSWP.m@ 1150

Last change on this file since 1150 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 1.4 KB
RevLine 
[613]1DDSWP ;SFISC/MKO-WP ;1:05 PM 23 Aug 1999
2 ;;22.0;VA FileMan;**8**;Mar 30, 1999
3 ;Per VHA Directive 10-93-142, this routine should not be modified.
4EDIT ;Edit the word processing field
5 N I
6 S DDSUE=$D(DDSTP)#2!$S($P($G(DDSU("A")),U,4)="":$P($G(DDSO(4)),U,4),1:$P(DDSU("A"),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")
30EDITQ K DDSUE,DDSUTL
31 Q
32 ;
33WP ;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
39HELP ;?? 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
Note: See TracBrowser for help on using the repository browser.