Annotation of freem_fileman/DDGF1.m, revision 1.1.1.1

1.1       snw         1: DDGF1  ;SFISC/MKO-MAIN SCREEN ;02:46 PM  12 Oct 1994
                      2:        ;;21.0;VA FileMan;;Dec 28, 1994
                      3:        ;Per VHA Directive 10-93-142, this routine should not be modified.
                      4:        D RC($P(DDGFLIM,U),$P(DDGFLIM,U,2))
                      5:        S DDGFE=0 F  S Y=$$READ W:$T(@Y)="" $C(7) D:$D(DDGFMSG) MSG^DDGF() D:$T(@Y)]"" @Y Q:DDGFE
                      6:        Q
                      7:        ;
                      8: LNU    I DY>$P(DDGFLIM,U) D RC(DY-1,DX)
                      9:        Q
                     10: LND    I DY<$P(DDGFLIM,U,3) D RC(DY+1,DX)
                     11:        Q
                     12: CHR    I DX<$P(DDGFLIM,U,4) D RC(DY,DX+1)
                     13:        Q
                     14: CHL    I DX>$P(DDGFLIM,U,2) D RC(DY,DX-1)
                     15:        Q
                     16:        ;
                     17: ELR    N Y,X
                     18:        S Y=DY,X=DX
                     19:        S X=$O(@DDGFREF@("RC",DDGFWID,Y,X))
                     20:        D:X=""
                     21:        . S Y=$O(@DDGFREF@("RC",DDGFWID,Y))
                     22:        . S:Y="" Y=$O(@DDGFREF@("RC",DDGFWID,""))
                     23:        . S:Y]"" X=$O(@DDGFREF@("RC",DDGFWID,Y,""))
                     24:        D:X]"" RC(Y,X)
                     25:        Q
                     26: ELL    N Y,X
                     27:        S Y=DY,X=DX
                     28:        S X=$O(@DDGFREF@("RC",DDGFWID,Y,X),-1)
                     29:        D:X=""
                     30:        . S Y=$O(@DDGFREF@("RC",DDGFWID,Y),-1)
                     31:        . S:Y="" Y=$O(@DDGFREF@("RC",DDGFWID,""),-1)
                     32:        . S:Y]"" X=$O(@DDGFREF@("RC",DDGFWID,Y,""),-1)
                     33:        D:X]"" RC(Y,X)
                     34:        Q
                     35:        ;
                     36: TBR    I DX<$P(DDGFLIM,U,4) D
                     37:        . D RC(DY,$S(DX+5'<$P(DDGFLIM,U,4):$P(DDGFLIM,U,4),1:DX+5))
                     38:        E  I DY<$P(DDGFLIM,U,3) D RC(DY+1,$P(DDGFLIM,U,2))
                     39:        Q
                     40: TBL    I DX>$P(DDGFLIM,U,2) D
                     41:        . D RC(DY,$S(DX-5'>$P(DDGFLIM,U,2):$P(DDGFLIM,U,2),1:DX-5))
                     42:        E  I DY>$P(DDGFLIM,U) D RC(DY-1,$P(DDGFLIM,U,4))
                     43:        Q
                     44:        ;
                     45: SCT    I DY>$P(DDGFLIM,U) D RC($P(DDGFLIM,U),DX)
                     46:        Q
                     47: SCB    I DY<$P(DDGFLIM,U,3) D RC($P(DDGFLIM,U,3),DX)
                     48:        Q
                     49: SCR    I DX<$P(DDGFLIM,U,4) D RC(DY,$P(DDGFLIM,U,4))
                     50:        Q
                     51: SCL    I DX>$P(DDGFLIM,U,2) D RC(DY,$P(DDGFLIM,U,2))
                     52:        Q
                     53:        ;
                     54: SAVE   ;Save data from DDGFREF
                     55:        I 'DDGFPG D ERR(110) Q
                     56:        G SAVE^DDGFSV
                     57:        ;
                     58: SELECT ;Select an item
                     59:        I 'DDGFPG D ERR(110) Q
                     60:        G SELECT^DDGFEL
                     61:        ;
                     62: EDIT   ;Edit a caption or data length
                     63:        I 'DDGFPG D ERR(110) Q
                     64:        G EDIT^DDGFEL
                     65:        ;
                     66: FLDADD ;Add a new field to the form
                     67:        I 'DDGFPG D ERR(110) Q
                     68:        G ADD^DDGFFLDA
                     69:        ;
                     70: VIEW   ;Go to block viewer
                     71:        I 'DDGFPG D ERR(110) Q
                     72:        I $O(@DDGFREF@("F",DDGFPG,""))="" D ERR(120) Q
                     73:        G ^DDGF3
                     74:        ;
                     75: BKADD  ;Add a new block
                     76:        I 'DDGFPG D ERR(110) Q
                     77:        G ADD^DDGFBK
                     78:        ;
                     79: HBKADD ;Add a header block
                     80:        I 'DDGFPG D ERR(110) Q
                     81:        G ADD^DDGFHBK
                     82:        ;
                     83: NXTPG  ;Go to next page
                     84:        I 'DDGFPG D ERR(110) Q
                     85:        D NXTPRV^DDGFPG(1) Q
                     86:        ;
                     87: PRVPG  ;Go to previous page
                     88:        I 'DDGFPG D ERR(110) Q
                     89:        D NXTPRV^DDGFPG(-1) Q
                     90:        ;
                     91: CLSPG  ;Close pop-up page
                     92:        G CLSPG^DDGFPG
                     93:        ;
                     94: PGSEL  ;Select a new page
                     95:        I 'DDGFPG D ERR(110) Q
                     96:        G PGSEL^DDGFPG
                     97:        ;
                     98: PGADD  ;Add a new page to the form
                     99:        G ADD^DDGFPG
                    100:        ;
                    101: PGEDIT ;Edit attributes of a page
                    102:        I 'DDGFPG D ERR(110) Q
                    103:        G EDIT^DDGFPG
                    104:        ;
                    105: FMSEL  ;Select another form
                    106:        G SEL^DDGFFM
                    107:        ;
                    108: FMADD  ;Add a new form
                    109:        G ADD^DDGFFM
                    110:        ;
                    111: FMEDIT ;Edit the form
                    112:        G EDIT^DDGFFM
                    113:        ;
                    114: HELP   ;Invoke help screens
                    115:        G HLP^DDGFH
                    116:        ;
                    117: TO     ;Time-out
                    118:        W $C(7)
                    119:        G QUIT
                    120:        ;
                    121: QUIT   ;Exit from form designer
                    122:        I DDGLSCR>1 G CLSPG^DDGFPG
                    123:        S DDGFE=1
                    124:        Q
                    125: EXIT   ;Save and exit
                    126:        I DDGLSCR>1 G CLSPG^DDGFPG
                    127:        S DDGFE=1
                    128:        G SAVE^DDGFSV
                    129:        ;
                    130: RC(DDGFY,DDGFX)        ;Update status line, reset DX and DY, move cursor
                    131:        N DDGFS
                    132:        I DDGFR D
                    133:        . S DY=IOSL-6,DX=IOM-9,DDGFS="R"_(DDGFY+1)_",C"_(DDGFX+1)
                    134:        . X IOXY W DDGFS_$J("",7-$L(DDGFS))
                    135:        S DY=DDGFY,DX=DDGFX X IOXY
                    136:        Q
                    137:        ;
                    138: READ() N S,Y
                    139:        F  R *Y:DTIME D C Q:Y'=-1
                    140:        Q Y
                    141:        ;
                    142: C      I Y<0 S Y="TO" Q
                    143:        S S=""
                    144: C1     S S=S_$C(Y)
                    145:        I DDGF("IN")'[(U_S) D  I Y=-1 W $C(7) Q
                    146:        . I $C(Y)'?1L S Y=-1 Q
                    147:        . S S=$E(S,1,$L(S)-1)_$C(Y-32) S:DDGF("IN")'[(U_S_U) Y=-1
                    148:        ;
                    149:        I DDGF("IN")[(U_S_U),S'=$C(27) S Y=$P(DDGF("OUT"),U,$L($P(DDGF("IN"),U_S_U),U)) Q
                    150:        R *Y:5 G:Y'=-1 C1 W $C(7)
                    151:        Q
                    152:        ;
                    153: ERR(X) ;
                    154:        D MSG^DDGF($C(7)_$P($T(@X),";;",2,999)) H 3
                    155:        D MSG^DDGF()
                    156:        Q
                    157: 110    ;;There are no pages on this form.  Use PF2-P to add a page.
                    158: 120    ;;There are no blocks on this page.  Use PF2-B to add a block.

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>