Routine: DDWC1

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)

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")

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

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

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDDWC1   1961     printed  Feb 19, 2025@00:10:16                                                                                                                                                                                                       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

DDWC1.m