DDWC1 ;SFISC/MKO-CHANGE ;04:37 PM 24 Aug 2002
;;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.
;
SETUP ;Setup new scrolling region
N DDWI
F DDWI=$$MIN(DDWMR,DDWCNT-DDWA):-1:DDWMR-4 D
. S DDWSTB=DDWSTB+1,^TMP("DDW1",$J,DDWSTB)=DDWL(DDWI)
S IOBM=IOBM-5,DDWMR=DDWMR-5
W:$P(DDGLED,DDGLDEL,2)]"" @$P(DDGLED,DDGLDEL,2)
;
;Print dialog box
N DDWR0,DDWR1
S DDWR1=$P(DDGLVID,DDGLDEL,6),DDWR0=$P(DDGLVID,DDGLDEL,10)
;
D CUP(DDWMR+1,1)
W $P(DDGLGRA,DDGLDEL)_$TR($J("",IOM)," ",$P(DDGLGRA,DDGLDEL,3))_$P(DDGLGRA,DDGLDEL,2),!
FIND D CUP(DDWMR+2,1) W $P(DDGLCLR,DDGLDEL)_" "_$$EZBLD^DIALOG(8126) ;**'FIND WHAT:'
D CUP(DDWMR+3,1) W $P(DDGLCLR,DDGLDEL)_$$EZBLD^DIALOG(8126.1)_$G(DDWCHG) ;**'REPLACE WITH:'
D CUP(DDWMR+4,1) W $P(DDGLCLR,DDGLDEL)_" Option:"_$P(DDGLCLR,DDGLDEL)_$J("",20)_DDWR1_"F"_DDWR0_"ind Next "_DDWR1_"R"_DDWR0_"eplace Replace "_DDWR1_"A"_DDWR0_"ll "_DDWR1_"Q"_DDWR0_"uit"
D CUP(DDWMR+5,1) W $P(DDGLCLR,DDGLDEL)
Q
;
RESTORE ;Restore original scrolling region
N DDWI
S IOBM=IOBM+5,DDWMR=DDWMR+5
W:$P(DDGLED,DDGLDEL,2)]"" @$P(DDGLED,DDGLDEL,2)
F DDWI=DDWMR-4:1:DDWMR D
. I DDWI+DDWA'>DDWCNT D
.. S DDWL(DDWI)=^TMP("DDW1",$J,DDWSTB),DDWSTB=DDWSTB-1
. E S DDWL(DDWI)=""
. D CUP(DDWI,1)
. W $P(DDGLCLR,DDGLDEL)_$E(DDWL(DDWI),1+DDWOFS,IOM+DDWOFS)
.
D POS(DDWRW,DDWC,"RN")
Q
;
MIN(X,Y) ;
Q $S(X<Y:X,1:Y)
;
CUP(Y,X) ;Pos cursor
S DY=IOTM+Y-2,DX=X-1 X IOXY
Q
;
POS(R,C,F) ;Pos cursor based on char pos C
N DDWX
S:$G(C)="E" C=$L($G(DDWL(R)))+1
S:$G(F)["N" DDWN=$G(DDWL(R))
S:$G(F)["R" DDWRW=R,DDWC=C
;
S DDWX=C-DDWOFS
I DDWX>IOM!(DDWX<1) D SHIFT^DDW3(C,.DDWOFS)
S DY=IOTM+R-2,DX=C-DDWOFS-1 X IOXY
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDDWC1 1961 printed Oct 16, 2024@18:44:35 Page 2
DDWC1 ;SFISC/MKO-CHANGE ;04:37 PM 24 Aug 2002
+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 ;
SETUP ;Setup new scrolling region
+1 NEW DDWI
+2 FOR DDWI=$$MIN(DDWMR,DDWCNT-DDWA):-1:DDWMR-4
Begin DoDot:1
+3 SET DDWSTB=DDWSTB+1
SET ^TMP("DDW1",$JOB,DDWSTB)=DDWL(DDWI)
End DoDot:1
+4 SET IOBM=IOBM-5
SET DDWMR=DDWMR-5
+5 if $PIECE(DDGLED,DDGLDEL,2)]""
WRITE @$PIECE(DDGLED,DDGLDEL,2)
+6 ;
+7 ;Print dialog box
+8 NEW DDWR0,DDWR1
+9 SET DDWR1=$PIECE(DDGLVID,DDGLDEL,6)
SET DDWR0=$PIECE(DDGLVID,DDGLDEL,10)
+10 ;
+11 DO CUP(DDWMR+1,1)
+12 WRITE $PIECE(DDGLGRA,DDGLDEL)_$TRANSLATE($JUSTIFY("",IOM)," ",$PIECE(DDGLGRA,DDGLDEL,3))_$PIECE(DDGLGRA,DDGLDEL,2),!
FIND ;**'FIND WHAT:'
DO CUP(DDWMR+2,1)
WRITE $PIECE(DDGLCLR,DDGLDEL)_" "_$$EZBLD^DIALOG(8126)
+1 ;**'REPLACE WITH:'
DO CUP(DDWMR+3,1)
WRITE $PIECE(DDGLCLR,DDGLDEL)_$$EZBLD^DIALOG(8126.1)_$GET(DDWCHG)
+2 DO CUP(DDWMR+4,1)
WRITE $PIECE(DDGLCLR,DDGLDEL)_" Option:"_$PIECE(DDGLCLR,DDGLDEL)_$JUSTIFY("",20)_DDWR1_"F"_DDWR0_"ind Next "_DDWR1_"R"_DDWR0_"eplace Replace "_DDWR1_"A"_DDWR0_"ll "_DDWR1_"Q"_DDWR0_"uit"
+3 DO CUP(DDWMR+5,1)
WRITE $PIECE(DDGLCLR,DDGLDEL)
+4 QUIT
+5 ;
RESTORE ;Restore original scrolling region
+1 NEW DDWI
+2 SET IOBM=IOBM+5
SET DDWMR=DDWMR+5
+3 if $PIECE(DDGLED,DDGLDEL,2)]""
WRITE @$PIECE(DDGLED,DDGLDEL,2)
+4 FOR DDWI=DDWMR-4:1:DDWMR
Begin DoDot:1
+5 IF DDWI+DDWA'>DDWCNT
Begin DoDot:2
+6 SET DDWL(DDWI)=^TMP("DDW1",$JOB,DDWSTB)
SET DDWSTB=DDWSTB-1
End DoDot:2
+7 IF '$TEST
SET DDWL(DDWI)=""
+8 DO CUP(DDWI,1)
+9 WRITE $PIECE(DDGLCLR,DDGLDEL)_$EXTRACT(DDWL(DDWI),1+DDWOFS,IOM+DDWOFS)
+10 End DoDot:1
+11 DO POS(DDWRW,DDWC,"RN")
+12 QUIT
+13 ;
MIN(X,Y) ;
+1 QUIT $SELECT(X<Y:X,1:Y)
+2 ;
CUP(Y,X) ;Pos cursor
+1 SET DY=IOTM+Y-2
SET DX=X-1
XECUTE IOXY
+2 QUIT
+3 ;
POS(R,C,F) ;Pos cursor based on char pos C
+1 NEW DDWX
+2 if $GET(C)="E"
SET C=$LENGTH($GET(DDWL(R)))+1
+3 if $GET(F)["N"
SET DDWN=$GET(DDWL(R))
+4 if $GET(F)["R"
SET DDWRW=R
SET DDWC=C
+5 ;
+6 SET DDWX=C-DDWOFS
+7 IF DDWX>IOM!(DDWX<1)
DO SHIFT^DDW3(C,.DDWOFS)
+8 SET DY=IOTM+R-2
SET DX=C-DDWOFS-1
XECUTE IOXY
+9 QUIT
