Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: DDSWP

DDSWP.m

Go to the documentation of this file.
  1. DDSWP ;SFISC/MKO-WP ;19DEC2015
  1. ;;22.2;VA FileMan;;Jan 05, 2016;Build 42
  1. ;;Per VA Directive 6402, this routine should not be modified.
  1. ;;Submitted to OSEHRA 5 January 2015 by the VISTA Expertise Network.
  1. ;;Based on Medsphere Systems Corporation's MSC FileMan 1051.
  1. ;;Licensed under the terms of the Apache License, Version 2.0.
  1. ;
  1. EDIT ;Edit the word processing field
  1. N I
  1. S DDSUE=$D(DDSTP)#2!$S($P($G(DDSU("A")),U,4)="":$P($G(DDSO(4)),U,4),1:$P(DDSU("A"),U,4))
  1. 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
  1. I DDSUE D I $D(DIRUT) K DIRUT,DUOUT,DIROUT G EDITQ
  1. .D:DDM CLRMSG^DDS
  1. .N DDSWP D BLD^DIALOG(8178,,,"DDSWP"),MSG^DDSMSG(.DDSWP) H 2 Q ;**
  1. S DDSUTL=$NA(@DDSREFT@("F"_DDP,DDSDA,DDSFLD))
  1. ;
  1. I $D(@DDSUTL@("F"))[0,$D(@(DDSGL_"0)"))#2 D
  1. . K @DDSUTL@("D")
  1. . M @DDSUTL@("D")=@($E(DDSGL,1,$L(DDSGL)-1)_")")
  1. MOUSEOFF W *27,"[?1000l"
  1. S (DY,DX)=0 X IOXY W $P(DDGLCLR,DDGLDEL,2)
  1. S DIC=$E(DDSUTL,1,$L(DDSUTL)-1)_",""D"",",DWPK=1
  1. S DIWESUB=$P($G(DDSU("DD")),U) K:DIWESUB="" DIWESUB
  1. ;S DDWFLAGS=$G(DDWFLAGS)_"K"
  1. D EN^DIWE ;,INIT^DDGLIB0()
  1. K DIC,DIWESUB,DWPK
  1. I 'DDSUE S DDSCHG=1,@DDSUTL@("F")=1
  1. E K @DDSUTL@("D")
  1. MOUSEON I $G(DDS)>0,$G(DDSMOUSY) W *27,"[?1000h"
  1. EDITQ K DDSUE,DDSUTL
  1. Q
  1. ;
  1. WP ;At the wp field
  1. S DIR(0)="FO^0:0"
  1. I $D(@DDSREFT@("XCAP")) G EGP ; EXECUTABLE CAPTION writes over "+"
  1. I $$WPLUS("F"_DDP,DDSDA,DDSFLD) S DIR("B")="+" ;WHEN CURSOR IS ON FIELD, "+" WILL SHOW IF THERE IS ALREADY W-P DATA THERE
  1. EGP S DIR("?")="^W $$EZBLD^DIALOG(8179)" ; "Press <Enter> to edit this word processing field."
  1. S DIR("??")="^D HELP^DDSWP"
  1. D ^DIR K DIR,DUOUT,DIRUT,DIROUT
  1. Q
  1. ;
  1. WPLUS(FFILE,DA,FIELD) ;SAYS WHETHER WP FIELD HAS SOME DATA
  1. ;EXAMPLE:
  1. ;^TMP("DDS",4028,181,"F666001","889,",15,"F")=1
  1. ;^TMP("DDS",4028,181,"F666001","889,",15,"M")="0^DIZ(666001,889,""17"",^666001.0"
  1. N WP
  1. I DA="" Q 0
  1. I 'FIELD Q 0
  1. I $G(@DDSREFT@(FFILE,DA,FIELD,"F"))=1 Q $O(^("D",0))>0 ;IF WE'VE EDITED, ARE THERE LINES LEFT?
  1. 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
  1. Q 0
  1. ;
  1. ;
  1. HELP ;?? help at the WP field
  1. S DDSFN=+$P(DDSU("M"),U,3)
  1. D:$G(^DD(DDSFN,.01,3))]"" MSG^DDSMSG($$HELP^DIALOGZ(DDSFN,.01)) ;**CCO/NI WORD-PROCESSING FIELD HELP
  1. X:$G(^DD(DDSFN,.01,4))]"" ^(4)
  1. D:$D(^DD(DDSFN,.01,21)) WP^DDSMSG("^DD("_DDSFN_",.01,21)")
  1. K DDSFN
  1. Q