DDGF1.m

DDGF1 ;SFISC/MKO-MAIN SCREEN ;02:46 PM  12 Oct 1994

 ;;22.0;VA FileMan;;Mar 30, 1999

 ;Per VHA Directive 10-93-142, this routine should not be modified.

 D RC($P(DDGFLIM,U),$P(DDGFLIM,U,2))

 S DDGFE=0 F  S Y=$$READ W:$T(@Y)="" $C(7) D:$D(DDGFMSG) MSG^DDGF() D:$T(@Y)]"" @Y Q:DDGFE

 Q

 ;

LNU I DY>$P(DDGFLIM,U) D RC(DY-1,DX)

 Q

LND I DY<$P(DDGFLIM,U,3) D RC(DY+1,DX)

 Q

CHR I DX<$P(DDGFLIM,U,4) D RC(DY,DX+1)

 Q

CHL I DX>$P(DDGFLIM,U,2) D RC(DY,DX-1)

 Q

 ;

ELR N Y,X

 S Y=DY,X=DX

 S X=$O(@DDGFREF@("RC",DDGFWID,Y,X))

 D:X=""

 . S Y=$O(@DDGFREF@("RC",DDGFWID,Y))

 . S:Y="" Y=$O(@DDGFREF@("RC",DDGFWID,""))

 . S:Y]"" X=$O(@DDGFREF@("RC",DDGFWID,Y,""))

 D:X]"" RC(Y,X)

 Q

ELL N Y,X

 S Y=DY,X=DX

 S X=$O(@DDGFREF@("RC",DDGFWID,Y,X),-1)

 D:X=""

 . S Y=$O(@DDGFREF@("RC",DDGFWID,Y),-1)

 . S:Y="" Y=$O(@DDGFREF@("RC",DDGFWID,""),-1)

 . S:Y]"" X=$O(@DDGFREF@("RC",DDGFWID,Y,""),-1)

 D:X]"" RC(Y,X)

 Q

 ;

TBR I DX<$P(DDGFLIM,U,4) D

 . D RC(DY,$S(DX+5'<$P(DDGFLIM,U,4):$P(DDGFLIM,U,4),1:DX+5))

 E  I DY<$P(DDGFLIM,U,3) D RC(DY+1,$P(DDGFLIM,U,2))

 Q

TBL I DX>$P(DDGFLIM,U,2) D

 . D RC(DY,$S(DX-5'>$P(DDGFLIM,U,2):$P(DDGFLIM,U,2),1:DX-5))

 E  I DY>$P(DDGFLIM,U) D RC(DY-1,$P(DDGFLIM,U,4))

 Q

 ;

SCT I DY>$P(DDGFLIM,U) D RC($P(DDGFLIM,U),DX)

 Q

SCB I DY<$P(DDGFLIM,U,3) D RC($P(DDGFLIM,U,3),DX)

 Q

SCR I DX<$P(DDGFLIM,U,4) D RC(DY,$P(DDGFLIM,U,4))

 Q

SCL I DX>$P(DDGFLIM,U,2) D RC(DY,$P(DDGFLIM,U,2))

 Q

 ;

SAVE ;Save data from DDGFREF

 I 'DDGFPG D ERR(110) Q

 G SAVE^DDGFSV

 ;

SELECT ;Select an item

 I 'DDGFPG D ERR(110) Q

 G SELECT^DDGFEL

 ;

EDIT ;Edit a caption or data length

 I 'DDGFPG D ERR(110) Q

 G EDIT^DDGFEL

 ;

FLDADD ;Add a new field to the form

 I 'DDGFPG D ERR(110) Q

 G ADD^DDGFFLDA

 ;

VIEW ;Go to block viewer

 I 'DDGFPG D ERR(110) Q

 I $O(@DDGFREF@("F",DDGFPG,""))="" D ERR(120) Q

 G ^DDGF3

 ;

BKADD ;Add a new block

 I 'DDGFPG D ERR(110) Q

 G ADD^DDGFBK

 ;

HBKADD ;Add a header block

 I 'DDGFPG D ERR(110) Q

 G ADD^DDGFHBK

 ;

NXTPG ;Go to next page

 I 'DDGFPG D ERR(110) Q

 D NXTPRV^DDGFPG(1) Q

 ;

PRVPG ;Go to previous page

 I 'DDGFPG D ERR(110) Q

 D NXTPRV^DDGFPG(-1) Q

 ;

CLSPG ;Close pop-up page

 G CLSPG^DDGFPG

 ;

PGSEL ;Select a new page

 I 'DDGFPG D ERR(110) Q

 G PGSEL^DDGFPG

 ;

PGADD ;Add a new page to the form

 G ADD^DDGFPG

 ;

PGEDIT ;Edit attributes of a page

 I 'DDGFPG D ERR(110) Q

 G EDIT^DDGFPG

 ;

FMSEL ;Select another form

 G SEL^DDGFFM

 ;

FMADD ;Add a new form

 G ADD^DDGFFM

 ;

FMEDIT ;Edit the form

 G EDIT^DDGFFM

 ;

HELP ;Invoke help screens

 G HLP^DDGFH

 ;

TO ;Time-out

 W $C(7)

 G QUIT

 ;

QUIT ;Exit from form designer

 I DDGLSCR>1 G CLSPG^DDGFPG

 S DDGFE=1

 Q

EXIT ;Save and exit

 I DDGLSCR>1 G CLSPG^DDGFPG

 S DDGFE=1

 G SAVE^DDGFSV

 ;

RC(DDGFY,DDGFX) ;Update status line, reset DX and DY, move cursor

 N DDGFS

 I DDGFR D

 . S DY=IOSL-6,DX=IOM-9,DDGFS="R"_(DDGFY+1)_",C"_(DDGFX+1)

 . X IOXY W DDGFS_$J("",7-$L(DDGFS))

 S DY=DDGFY,DX=DDGFX X IOXY

 Q

 ;

READ() N S,Y

 F  R *Y:DTIME D C Q:Y'=-1

 Q Y

 ;

C I Y<0 S Y="TO" Q

 S S=""

C1 S S=S_$C(Y)

 I DDGF("IN")'[(U_S) D  I Y=-1 W $C(7) Q

 . I $C(Y)'?1L S Y=-1 Q

 . S S=$E(S,1,$L(S)-1)_$C(Y-32) S:DDGF("IN")'[(U_S_U) Y=-1

 ;

 I DDGF("IN")[(U_S_U),S'=$C(27) S Y=$P(DDGF("OUT"),U,$L($P(DDGF("IN"),U_S_U),U)) Q

 R *Y:5 G:Y'=-1 C1 W $C(7)

 Q

 ;

ERR(X) ;

 D MSG^DDGF($C(7)_$P($T(@X),";;",2,999)) H 3

 D MSG^DDGF()

 Q

110 ;;There are no pages on this form.  Use PF2-P to add a page.

120 ;;There are no blocks on this page.  Use PF2-B to add a block.

DDGF1     ;SFISC/MKO-MAIN SCREEN ;02:46 PM  12 Oct 1994

 +1       ;;22.0;VA FileMan;;Mar 30, 1999

 +2       ;Per VHA Directive 10-93-142, this routine should not be modified.

 +3        DO RC($PIECE(DDGFLIM,U),$PIECE(DDGFLIM,U,2))

 +4        SET DDGFE=0

           FOR 

               SET Y=$$READ

               IF $TEXT(@Y)=""

                   WRITE $CHAR(7)

               IF $DATA(DDGFMSG)

                   DO MSG^DDGF()

               IF $TEXT(@Y)]""

                   DO @Y

               IF DDGFE

                   QUIT 

 +5        QUIT 

 +6       ;

LNU        IF DY>$PIECE(DDGFLIM,U)

               DO RC(DY-1,DX)

 +1        QUIT 

LND        IF DY<$PIECE(DDGFLIM,U,3)

               DO RC(DY+1,DX)

 +1        QUIT 

CHR        IF DX<$PIECE(DDGFLIM,U,4)

               DO RC(DY,DX+1)

 +1        QUIT 

CHL        IF DX>$PIECE(DDGFLIM,U,2)

               DO RC(DY,DX-1)

 +1        QUIT 

 +2       ;

ELR        NEW Y,X

 +1        SET Y=DY

           SET X=DX

 +2        SET X=$ORDER(@DDGFREF@("RC",DDGFWID,Y,X))

 +3        IF X=""

               Begin DoDot:1

 +4                SET Y=$ORDER(@DDGFREF@("RC",DDGFWID,Y))

 +5                IF Y=""

                       SET Y=$ORDER(@DDGFREF@("RC",DDGFWID,""))

 +6                IF Y]""

                       SET X=$ORDER(@DDGFREF@("RC",DDGFWID,Y,""))

               End DoDot:1

 +7        IF X]""

               DO RC(Y,X)

 +8        QUIT 

ELL        NEW Y,X

 +1        SET Y=DY

           SET X=DX

 +2        SET X=$ORDER(@DDGFREF@("RC",DDGFWID,Y,X),-1)

 +3        IF X=""

               Begin DoDot:1

 +4                SET Y=$ORDER(@DDGFREF@("RC",DDGFWID,Y),-1)

 +5                IF Y=""

                       SET Y=$ORDER(@DDGFREF@("RC",DDGFWID,""),-1)

 +6                IF Y]""

                       SET X=$ORDER(@DDGFREF@("RC",DDGFWID,Y,""),-1)

               End DoDot:1

 +7        IF X]""

               DO RC(Y,X)

 +8        QUIT 

 +9       ;

TBR        IF DX<$PIECE(DDGFLIM,U,4)

               Begin DoDot:1

 +1                DO RC(DY,$SELECT(DX+5'<$PIECE(DDGFLIM,U,4):$PIECE(DDGFLIM,U,4),1:DX+5))

               End DoDot:1

 +2       IF '$TEST

               IF DY<$PIECE(DDGFLIM,U,3)

                   DO RC(DY+1,$PIECE(DDGFLIM,U,2))

 +3        QUIT 

TBL        IF DX>$PIECE(DDGFLIM,U,2)

               Begin DoDot:1

 +1                DO RC(DY,$SELECT(DX-5'>$PIECE(DDGFLIM,U,2):$PIECE(DDGFLIM,U,2),1:DX-5))

               End DoDot:1

 +2       IF '$TEST

               IF DY>$PIECE(DDGFLIM,U)

                   DO RC(DY-1,$PIECE(DDGFLIM,U,4))

 +3        QUIT 

 +4       ;

SCT        IF DY>$PIECE(DDGFLIM,U)

               DO RC($PIECE(DDGFLIM,U),DX)

 +1        QUIT 

SCB        IF DY<$PIECE(DDGFLIM,U,3)

               DO RC($PIECE(DDGFLIM,U,3),DX)

 +1        QUIT 

SCR        IF DX<$PIECE(DDGFLIM,U,4)

               DO RC(DY,$PIECE(DDGFLIM,U,4))

 +1        QUIT 

SCL        IF DX>$PIECE(DDGFLIM,U,2)

               DO RC(DY,$PIECE(DDGFLIM,U,2))

 +1        QUIT 

 +2       ;

SAVE      ;Save data from DDGFREF

 +1        IF 'DDGFPG

               DO ERR(110)

               QUIT 

 +2        GOTO SAVE^DDGFSV

 +3       ;

SELECT    ;Select an item

 +1        IF 'DDGFPG

               DO ERR(110)

               QUIT 

 +2        GOTO SELECT^DDGFEL

 +3       ;

EDIT      ;Edit a caption or data length

 +1        IF 'DDGFPG

               DO ERR(110)

               QUIT 

 +2        GOTO EDIT^DDGFEL

 +3       ;

FLDADD    ;Add a new field to the form

 +1        IF 'DDGFPG

               DO ERR(110)

               QUIT 

 +2        GOTO ADD^DDGFFLDA

 +3       ;

VIEW      ;Go to block viewer

 +1        IF 'DDGFPG

               DO ERR(110)

               QUIT 

 +2        IF $ORDER(@DDGFREF@("F",DDGFPG,""))=""

               DO ERR(120)

               QUIT 

 +3        GOTO ^DDGF3

 +4       ;

BKADD     ;Add a new block

 +1        IF 'DDGFPG

               DO ERR(110)

               QUIT 

 +2        GOTO ADD^DDGFBK

 +3       ;

HBKADD    ;Add a header block

 +1        IF 'DDGFPG

               DO ERR(110)

               QUIT 

 +2        GOTO ADD^DDGFHBK

 +3       ;

NXTPG     ;Go to next page

 +1        IF 'DDGFPG

               DO ERR(110)

               QUIT 

 +2        DO NXTPRV^DDGFPG(1)

           QUIT 

 +3       ;

PRVPG     ;Go to previous page

 +1        IF 'DDGFPG

               DO ERR(110)

               QUIT 

 +2        DO NXTPRV^DDGFPG(-1)

           QUIT 

 +3       ;

CLSPG     ;Close pop-up page

 +1        GOTO CLSPG^DDGFPG

 +2       ;

PGSEL     ;Select a new page

 +1        IF 'DDGFPG

               DO ERR(110)

               QUIT 

 +2        GOTO PGSEL^DDGFPG

 +3       ;

PGADD     ;Add a new page to the form

 +1        GOTO ADD^DDGFPG

 +2       ;

PGEDIT    ;Edit attributes of a page

 +1        IF 'DDGFPG

               DO ERR(110)

               QUIT 

 +2        GOTO EDIT^DDGFPG

 +3       ;

FMSEL     ;Select another form

 +1        GOTO SEL^DDGFFM

 +2       ;

FMADD     ;Add a new form

 +1        GOTO ADD^DDGFFM

 +2       ;

FMEDIT    ;Edit the form

 +1        GOTO EDIT^DDGFFM

 +2       ;

HELP      ;Invoke help screens

 +1        GOTO HLP^DDGFH

 +2       ;

TO        ;Time-out

 +1        WRITE $CHAR(7)

 +2        GOTO QUIT

 +3       ;

QUIT      ;Exit from form designer

 +1        IF DDGLSCR>1

               GOTO CLSPG^DDGFPG

 +2        SET DDGFE=1

 +3        QUIT 

EXIT      ;Save and exit

 +1        IF DDGLSCR>1

               GOTO CLSPG^DDGFPG

 +2        SET DDGFE=1

 +3        GOTO SAVE^DDGFSV

 +4       ;

RC(DDGFY,DDGFX) ;Update status line, reset DX and DY, move cursor

 +1        NEW DDGFS

 +2        IF DDGFR

               Begin DoDot:1

 +3                SET DY=IOSL-6

                   SET DX=IOM-9

                   SET DDGFS="R"_(DDGFY+1)_",C"_(DDGFX+1)

 +4                XECUTE IOXY

                   WRITE DDGFS_$JUSTIFY("",7-$LENGTH(DDGFS))

               End DoDot:1

 +5        SET DY=DDGFY

           SET DX=DDGFX

           XECUTE IOXY

 +6        QUIT 

 +7       ;

READ()     NEW S,Y

 +1        FOR 

               READ *Y:DTIME

               DO C

               IF Y'=-1

                   QUIT 

 +2        QUIT Y

 +3       ;

C          IF Y<0

               SET Y="TO"

               QUIT 

 +1        SET S=""

C1         SET S=S_$CHAR(Y)

 +1        IF DDGF("IN")'[(U_S)

               Begin DoDot:1

 +2                IF $CHAR(Y)'?1L

                       SET Y=-1

                       QUIT 

 +3                SET S=$EXTRACT(S,1,$LENGTH(S)-1)_$CHAR(Y-32)

                   IF DDGF("IN")'[(U_S_U)

                       SET Y=-1

               End DoDot:1

               IF Y=-1

                   WRITE $CHAR(7)

                   QUIT 

 +4       ;

 +5        IF DDGF("IN")[(U_S_U)

               IF S'=$CHAR(27)

                   SET Y=$PIECE(DDGF("OUT"),U,$LENGTH($PIECE(DDGF("IN"),U_S_U),U))

                   QUIT 

 +6        READ *Y:5

           IF Y'=-1

               GOTO C1

           WRITE $CHAR(7)

 +7        QUIT 

 +8       ;

ERR(X)    ;

 +1        DO MSG^DDGF($CHAR(7)_$PIECE($TEXT(@X),";;",2,999))

           HANG 3

 +2        DO MSG^DDGF()

 +3        QUIT 

110       ;;There are no pages on this form.  Use PF2-P to add a page.

120       ;;There are no blocks on this page.  Use PF2-B to add a block.