- 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 Jan 18, 2025@03:44:38 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