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

DDWG.m

Go to the documentation of this file.
  1. DDWG ;SFISC/MKO-GOTO ;05:49 PM 24 Aug 2002
  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. GOTO ;Go to a specific location
  1. N DDWANS,DDWI,DDWHLP
  1. D BLD^DIALOG(8140,,,"DDWHLP") ;**
  1. D ASK(4,$$EZBLD^DIALOG(7069)_": ",17,"","D VALGTO",.DDWHLP,.DDWANS) ;**
  1. I U[DDWANS
  1. E I "Ss"[$E(DDWANS)!(DDWANS'?1A.E) D
  1. . D GOTOS
  1. E I "Ll"[$E(DDWANS) D
  1. . D GOTOL
  1. E I "Cc"[$E(DDWANS) D
  1. . D GOTOC
  1. Q
  1. ;
  1. GOTOS ;Go to a page
  1. N DDWS
  1. S DDWS=DDWANS
  1. S:DDWS?1A.E DDWS=$E(DDWS,2,999)
  1. S:DDWS?1P.E DDWS=$E(DDWS,2,999)
  1. I DDWANS["+" S DDWS=$$SCREEN+DDWS
  1. E I DDWANS["-" S DDWS=$$SCREEN-DDWS
  1. I DDWS<1 S DDWS=1
  1. E I DDWS>$$LTOSC(DDWCNT) S DDWS=$$LTOSC(DDWCNT)
  1. D LINE(DDWS-1*DDWMR+1)
  1. Q
  1. ;
  1. GOTOL ;Go to a line
  1. N DDWLN
  1. S DDWLN=DDWANS
  1. S:DDWLN?1A.E DDWLN=$E(DDWLN,2,999)
  1. S:DDWLN?1P.E DDWLN=$E(DDWLN,2,999)
  1. I DDWANS["+" S DDWLN=DDWA+DDWRW+DDWLN
  1. E I DDWANS["-" S DDWLN=DDWA+DDWRW-DDWLN
  1. I DDWLN<1 S DDWLN=1
  1. E I DDWLN>DDWCNT S DDWLN=DDWCNT
  1. D LINE(DDWLN)
  1. Q
  1. ;
  1. GOTOC ;Go to a column
  1. N DDWCOL
  1. S DDWCOL=DDWANS
  1. S:DDWCOL?1A.E DDWCOL=$E(DDWCOL,2,999)
  1. S:DDWCOL?1P.E DDWCOL=$E(DDWCOL,2,999)
  1. I DDWANS["+" S DDWCOL=DDWC+DDWCOL
  1. E I DDWANS["-" S DDWCOL=DDWC-DDWCOL
  1. I DDWCOL<1 S DDWCOL=1
  1. E I DDWCOL>246 S DDWCOL=246
  1. D POS(DDWRW,DDWCOL,"R")
  1. Q
  1. ;
  1. LINE(DDWLN,DDWCOL) ;Adjust arrays and position cursor on line DDWLN
  1. I $G(DDWCOL)'="E",'$G(DDWCOL) S DDWCOL=1
  1. S:DDWLN>DDWCNT DDWLN=DDWCNT
  1. I DDWLN>DDWA,DDWLN'>(DDWA+DDWMR-1) D
  1. . D POS(DDWLN-DDWA,DDWCOL,"RN")
  1. E I DDWLN>DDWA D
  1. . D SHFTDN^DDW3(DDWLN,DDWCOL),POS(DDWLN-DDWA,DDWCOL,"RN")
  1. E D
  1. . D SHFTUP^DDW3(DDWLN),POS(1,DDWCOL,"RN")
  1. Q
  1. ;
  1. ASK(DDWLC,DDWS,DDWLEN,DDWDEF,DDWVAL,DDWHLP,DDWANS,DDWCOD) ;Prompt user
  1. N DDWI
  1. D CUP(DDWMR-DDWLC,1)
  1. W $P(DDGLGRA,DDGLDEL)_$TR($J("",IOM)," ",$P(DDGLGRA,DDGLDEL,3))_$P(DDGLGRA,DDGLDEL,2)
  1. F DDWI=DDWMR-DDWLC+1:1:DDWMR D CUP(DDWI,1) W $P(DDGLCLR,DDGLDEL)
  1. K DDWANS F D PROMPT Q:$D(DDWANS)
  1. ;
  1. F DDWI=DDWMR-DDWLC:1:DDWMR D
  1. . D CUP(DDWI,1)
  1. . W $P(DDGLCLR,DDGLDEL)_$E(DDWL(DDWI),1+DDWOFS,IOM+DDWOFS)
  1. D POS(DDWRW,DDWC,"RN")
  1. Q
  1. ;
  1. PROMPT ;Issue read
  1. N DDWERR,DDWX
  1. D CUP(DDWMR-DDWLC+1,1) W DDWS_$P(DDGLCLR,DDGLDEL)
  1. D EN^DIR0(IOTM+DDWMR-DDWLC-1,$L(DDWS),DDWLEN,1,$G(DDWDEF),245,"","","AKTW",.DDWX,.DDWCOD)
  1. ;
  1. I DDWX?1."?",$D(DDWHLP)>9!($G(DDWHLP)]"") D HELP(.DDWHLP) Q
  1. I $G(DDWVAL)]"" X DDWVAL I $D(DDWERR) W $C(7) D HELP(.DDWERR) Q
  1. S DDWANS=DDWX
  1. Q
  1. ;
  1. VALGTO ;Validate DDWX
  1. N DDWCH
  1. Q:U[DDWX
  1. S DDWERR=$$EZBLD^DIALOG(1401) ;**
  1. Q:DDWX'?.1A.1P1.15N
  1. I DDWX?1A.E S DDWCH=$E(DDWX) Q:"SsLlCc"'[DDWCH
  1. I DDWX?.E1P.E I DDWX'["+",DDWX'["-" Q
  1. K DDWERR
  1. Q
  1. ;
  1. HELP(DDWMSG) ;Print message
  1. N DDWI,DDWEC
  1. S:$D(DDWMSG)<9 DDWMSG(1)=DDWMSG
  1. S DDWEC=$O(DDWMSG(""),-1)
  1. F DDWI=2:1:DDWLC D
  1. . D CUP(DDWMR-DDWLC+DDWI,1)
  1. . W $P(DDGLCLR,DDGLDEL)_$G(DDWMSG(DDWI-DDWLC+DDWEC))
  1. Q
  1. ;
  1. SCREEN() ;Return current screen
  1. Q DDWA+DDWRW-1\DDWMR+1
  1. ;
  1. LTOSC(L) ;Convert line number to page number
  1. Q L-1\DDWMR+1
  1. ;
  1. CUP(Y,X) ;Pos cursor
  1. S DY=IOTM+Y-2,DX=X-1 X IOXY
  1. Q
  1. ;
  1. POS(R,C,F) ;Pos cursor based on char pos C
  1. N DDWX
  1. S:$G(C)="E" C=$L($G(DDWL(R)))+1
  1. S:$G(F)["N" DDWN=$G(DDWL(R))
  1. S:$G(F)["R" DDWRW=R,DDWC=C
  1. ;
  1. S DDWX=C-DDWOFS
  1. I DDWX>IOM!(DDWX<1) D SHIFT^DDW3(C,.DDWOFS)
  1. S DY=IOTM+R-2,DX=C-DDWOFS-1 X IOXY
  1. Q