DDSWP.m

DDSWP ;SFISC/MKO-WP ;1:05 PM  23 Aug 1999 [ 04/02/2003   8:25 AM ]

 ;;22.0;VA FileMan;**1001**;APR 1, 2003

 ;;22.0;VA FileMan;**8**;Mar 30, 1999

 ;Per VHA Directive 10-93-142, this routine should not be modified.

EDIT ;Edit the word processing field

 N I

 S DDSUE=$D(DDSTP)#2!$S($P($G(DDSU("A")),U,4)="":$P($G(DDSO(4)),U,4),1:$P(DDSU("A"),U,4))

 I DDSUE D  I $D(DIRUT) K DIRUT,DUOUT,DIROUT G EDITQ

 . D:DDM CLRMSG^DDS

 . K DIR S DIR(0)="E"

 . S DIR("A",1)="WARNING: This field is uneditable."

 . S DIR("A",2)="         Any changes made in the editor will not be saved."

 . S DIR("A",3)=""

 . S DIR("A")="Press RETURN to enter editor:"

 . S DIR0=IOSL-1_U_($L(DIR("A"))+1)_"^1^"_(IOSL-4)_"^0"

 . D ^DIR K DIR

 ;

 S DDSUTL=$NA(@DDSREFT@("F"_DDP,DDSDA,DDSFLD))

 ;

 I $D(@DDSUTL@("F"))[0,$D(@(DDSGL_"0)"))#2 D

 . K @DDSUTL@("D")

 . M @DDSUTL@("D")=@($E(DDSGL,1,$L(DDSGL)-1)_")")

 ;

 S (DY,DX)=0 X IOXY W $P(DDGLCLR,DDGLDEL,2)

 S DIC=$E(DDSUTL,1,$L(DDSUTL)-1)_",""D"",",DWPK=1

 S DIWESUB=$P($G(DDSU("DD")),U) K:DIWESUB="" DIWESUB

 D EN^DIWE

 K DIC,DIWESUB,DWPK

 I 'DDSUE S DDSCHG=1,@DDSUTL@("F")=1

 E  K @DDSUTL@("D")

EDITQ K DDSUE,DDSUTL

 Q

 ;

WP ;At the wp field

 S DIR(0)="FO^0:0"

 S DIR("?")="^W ""Press 'RETURN' to edit this word processing field."""

 S DIR("??")="^D HELP^DDSWP"

 D ^DIR K DIR,DUOUT,DIRUT,DIROUT

 Q

HELP ;?? help at the WP field

 S DDSFN=+$P(DDSU("M"),U,3)

 D:$G(^DD(DDSFN,.01,3))]"" MSG^DDSMSG(^(3))

 X:$G(^DD(DDSFN,.01,4))]"" ^(4)

 D:$D(^DD(DDSFN,.01,21)) WP^DDSMSG("^DD("_DDSFN_",.01,21)")

 K DDSFN

 Q

DDSWP     ;SFISC/MKO-WP ;1:05 PM  23 Aug 1999 [ 04/02/2003   8:25 AM ]

 +1       ;;22.0;VA FileMan;**1001**;APR 1, 2003

 +2       ;;22.0;VA FileMan;**8**;Mar 30, 1999

 +3       ;Per VHA Directive 10-93-142, this routine should not be modified.

EDIT      ;Edit the word processing field

 +1        NEW I

 +2        SET DDSUE=$DATA(DDSTP)#2!$SELECT($PIECE($GET(DDSU("A")),U,4)="":$PIECE($GET(DDSO(4)),U,4),1:$PIECE(DDSU("A"),U,4))

 +3        IF DDSUE

               Begin DoDot:1

 +4                IF DDM

                       DO CLRMSG^DDS

 +5                KILL DIR

                   SET DIR(0)="E"

 +6                SET DIR("A",1)="WARNING: This field is uneditable."

 +7                SET DIR("A",2)="         Any changes made in the editor will not be saved."

 +8                SET DIR("A",3)=""

 +9                SET DIR("A")="Press RETURN to enter editor:"

 +10               SET DIR0=IOSL-1_U_($LENGTH(DIR("A"))+1)_"^1^"_(IOSL-4)_"^0"

 +11               DO ^DIR

                   KILL DIR

               End DoDot:1

               IF $DATA(DIRUT)

                   KILL DIRUT,DUOUT,DIROUT

                   GOTO EDITQ

 +12      ;

 +13       SET DDSUTL=$NAME(@DDSREFT@("F"_DDP,DDSDA,DDSFLD))

 +14      ;

 +15       IF $DATA(@DDSUTL@("F"))[0

               IF $DATA(@(DDSGL_"0)"))#2

                   Begin DoDot:1

 +16                   KILL @DDSUTL@("D")

 +17                   MERGE @DDSUTL@("D")=@($EXTRACT(DDSGL,1,$LENGTH(DDSGL)-1)_")")

                   End DoDot:1

 +18      ;

 +19       SET (DY,DX)=0

           XECUTE IOXY

           WRITE $PIECE(DDGLCLR,DDGLDEL,2)

 +20       SET DIC=$EXTRACT(DDSUTL,1,$LENGTH(DDSUTL)-1)_",""D"","

           SET DWPK=1

 +21       SET DIWESUB=$PIECE($GET(DDSU("DD")),U)

           IF DIWESUB=""

               KILL DIWESUB

 +22       DO EN^DIWE

 +23       KILL DIC,DIWESUB,DWPK

 +24       IF 'DDSUE

               SET DDSCHG=1

               SET @DDSUTL@("F")=1

 +25      IF '$TEST

               KILL @DDSUTL@("D")

EDITQ      KILL DDSUE,DDSUTL

 +1        QUIT 

 +2       ;

WP        ;At the wp field

 +1        SET DIR(0)="FO^0:0"

 +2        SET DIR("?")="^W ""Press 'RETURN' to edit this word processing field."""

 +3        SET DIR("??")="^D HELP^DDSWP"

 +4        DO ^DIR

           KILL DIR,DUOUT,DIRUT,DIROUT

 +5        QUIT 

HELP      ;?? help at the WP field

 +1        SET DDSFN=+$PIECE(DDSU("M"),U,3)

 +2        IF $GET(^DD(DDSFN,.01,3))]""

               DO MSG^DDSMSG(^(3))

 +3        IF $GET(^DD(DDSFN,.01,4))]""

               XECUTE ^(4)

 +4        IF $DATA(^DD(DDSFN,.01,21))

               DO WP^DDSMSG("^DD("_DDSFN_",.01,21)")

 +5        KILL DDSFN

 +6        QUIT