DDSWP ;SFISC/MKO-WP ;19DEC2015
;;22.2;VA FileMan;;Jan 05, 2016;Build 42
;;Per VA Directive 6402, this routine should not be modified.
;;Submitted to OSEHRA 5 January 2015 by the VISTA Expertise Network.
;;Based on Medsphere Systems Corporation's MSC FileMan 1051.
;;Licensed under the terms of the Apache License, Version 2.0.
;
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 S I=$P((DDSU("DD")),U,2) I I,$P($G(^DD(I,.01,0)),U,2)["I",$G(DDSGL)["(",$O(@(DDSGL_"0)")) S DDSUE=1 ;UNEDITABLE WORD-PROCESSING FIELD
I DDSUE D I $D(DIRUT) K DIRUT,DUOUT,DIROUT G EDITQ
.D:DDM CLRMSG^DDS
.N DDSWP D BLD^DIALOG(8178,,,"DDSWP"),MSG^DDSMSG(.DDSWP) H 2 Q ;**
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)_")")
MOUSEOFF W *27,"[?1000l"
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
;S DDWFLAGS=$G(DDWFLAGS)_"K"
D EN^DIWE ;,INIT^DDGLIB0()
K DIC,DIWESUB,DWPK
I 'DDSUE S DDSCHG=1,@DDSUTL@("F")=1
E K @DDSUTL@("D")
MOUSEON I $G(DDS)>0,$G(DDSMOUSY) W *27,"[?1000h"
EDITQ K DDSUE,DDSUTL
Q
;
WP ;At the wp field
S DIR(0)="FO^0:0"
I $D(@DDSREFT@("XCAP")) G EGP ; EXECUTABLE CAPTION writes over "+"
I $$WPLUS("F"_DDP,DDSDA,DDSFLD) S DIR("B")="+" ;WHEN CURSOR IS ON FIELD, "+" WILL SHOW IF THERE IS ALREADY W-P DATA THERE
EGP S DIR("?")="^W $$EZBLD^DIALOG(8179)" ; "Press <Enter> to edit this word processing field."
S DIR("??")="^D HELP^DDSWP"
D ^DIR K DIR,DUOUT,DIRUT,DIROUT
Q
;
WPLUS(FFILE,DA,FIELD) ;SAYS WHETHER WP FIELD HAS SOME DATA
;EXAMPLE:
;^TMP("DDS",4028,181,"F666001","889,",15,"F")=1
;^TMP("DDS",4028,181,"F666001","889,",15,"M")="0^DIZ(666001,889,""17"",^666001.0"
N WP
I DA="" Q 0
I 'FIELD Q 0
I $G(@DDSREFT@(FFILE,DA,FIELD,"F"))=1 Q $O(^("D",0))>0 ;IF WE'VE EDITED, ARE THERE LINES LEFT?
I $G(@DDSREFT@(FFILE,DA,FIELD,"M"))?1"0^".E S WP=$P(^("M"),U,2) I WP["(" S WP=U_$$CREF^DILF(WP_0),WP=$P($G(@WP),U,3) Q ''WP ;IF WE HAVEN'T EDITED, LOOK IN THE DATA
Q 0
;
;
HELP ;?? help at the WP field
S DDSFN=+$P(DDSU("M"),U,3)
D:$G(^DD(DDSFN,.01,3))]"" MSG^DDSMSG($$HELP^DIALOGZ(DDSFN,.01)) ;**CCO/NI WORD-PROCESSING FIELD HELP
X:$G(^DD(DDSFN,.01,4))]"" ^(4)
D:$D(^DD(DDSFN,.01,21)) WP^DDSMSG("^DD("_DDSFN_",.01,21)")
K DDSFN
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDDSWP 2524 printed Dec 13, 2024@02:43:40 Page 2
DDSWP ;SFISC/MKO-WP ;19DEC2015
+1 ;;22.2;VA FileMan;;Jan 05, 2016;Build 42
+2 ;;Per VA Directive 6402, this routine should not be modified.
+3 ;;Submitted to OSEHRA 5 January 2015 by the VISTA Expertise Network.
+4 ;;Based on Medsphere Systems Corporation's MSC FileMan 1051.
+5 ;;Licensed under the terms of the Apache License, Version 2.0.
+6 ;
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 ;UNEDITABLE WORD-PROCESSING FIELD
IF 'DDSUE
SET I=$PIECE((DDSU("DD")),U,2)
IF I
IF $PIECE($GET(^DD(I,.01,0)),U,2)["I"
IF $GET(DDSGL)["("
IF $ORDER(@(DDSGL_"0)"))
SET DDSUE=1
+4 IF DDSUE
Begin DoDot:1
+5 if DDM
DO CLRMSG^DDS
+6 ;**
NEW DDSWP
DO BLD^DIALOG(8178,,,"DDSWP")
DO MSG^DDSMSG(.DDSWP)
HANG 2
QUIT
End DoDot:1
IF $DATA(DIRUT)
KILL DIRUT,DUOUT,DIROUT
GOTO EDITQ
+7 SET DDSUTL=$NAME(@DDSREFT@("F"_DDP,DDSDA,DDSFLD))
+8 ;
+9 IF $DATA(@DDSUTL@("F"))[0
IF $DATA(@(DDSGL_"0)"))#2
Begin DoDot:1
+10 KILL @DDSUTL@("D")
+11 MERGE @DDSUTL@("D")=@($EXTRACT(DDSGL,1,$LENGTH(DDSGL)-1)_")")
End DoDot:1
MOUSEOFF WRITE *27,"[?1000l"
+1 SET (DY,DX)=0
XECUTE IOXY
WRITE $PIECE(DDGLCLR,DDGLDEL,2)
+2 SET DIC=$EXTRACT(DDSUTL,1,$LENGTH(DDSUTL)-1)_",""D"","
SET DWPK=1
+3 SET DIWESUB=$PIECE($GET(DDSU("DD")),U)
if DIWESUB=""
KILL DIWESUB
+4 ;S DDWFLAGS=$G(DDWFLAGS)_"K"
+5 ;,INIT^DDGLIB0()
DO EN^DIWE
+6 KILL DIC,DIWESUB,DWPK
+7 IF 'DDSUE
SET DDSCHG=1
SET @DDSUTL@("F")=1
+8 IF '$TEST
KILL @DDSUTL@("D")
MOUSEON IF $GET(DDS)>0
IF $GET(DDSMOUSY)
WRITE *27,"[?1000h"
EDITQ KILL DDSUE,DDSUTL
+1 QUIT
+2 ;
WP ;At the wp field
+1 SET DIR(0)="FO^0:0"
+2 ; EXECUTABLE CAPTION writes over "+"
IF $DATA(@DDSREFT@("XCAP"))
GOTO EGP
+3 ;WHEN CURSOR IS ON FIELD, "+" WILL SHOW IF THERE IS ALREADY W-P DATA THERE
IF $$WPLUS("F"_DDP,DDSDA,DDSFLD)
SET DIR("B")="+"
EGP ; "Press <Enter> to edit this word processing field."
SET DIR("?")="^W $$EZBLD^DIALOG(8179)"
+1 SET DIR("??")="^D HELP^DDSWP"
+2 DO ^DIR
KILL DIR,DUOUT,DIRUT,DIROUT
+3 QUIT
+4 ;
WPLUS(FFILE,DA,FIELD) ;SAYS WHETHER WP FIELD HAS SOME DATA
+1 ;EXAMPLE:
+2 ;^TMP("DDS",4028,181,"F666001","889,",15,"F")=1
+3 ;^TMP("DDS",4028,181,"F666001","889,",15,"M")="0^DIZ(666001,889,""17"",^666001.0"
+4 NEW WP
+5 IF DA=""
QUIT 0
+6 IF 'FIELD
QUIT 0
+7 ;IF WE'VE EDITED, ARE THERE LINES LEFT?
IF $GET(@DDSREFT@(FFILE,DA,FIELD,"F"))=1
QUIT $ORDER(^("D",0))>0
+8 ;IF WE HAVEN'T EDITED, LOOK IN THE DATA
IF $GET(@DDSREFT@(FFILE,DA,FIELD,"M"))?1"0^".E
SET WP=$PIECE(^("M"),U,2)
IF WP["("
SET WP=U_$$CREF^DILF(WP_0)
SET WP=$PIECE($GET(@WP),U,3)
QUIT ''WP
+9 QUIT 0
+10 ;
+11 ;
HELP ;?? help at the WP field
+1 SET DDSFN=+$PIECE(DDSU("M"),U,3)
+2 ;**CCO/NI WORD-PROCESSING FIELD HELP
if $GET(^DD(DDSFN,.01,3))]""
DO MSG^DDSMSG($$HELP^DIALOGZ(DDSFN,.01))
+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
