File:  [Coherent Logic Development] / freem_fileman / USER / DDGF0.m
Revision 1.1: download - view: text, annotated - select for diffs
Mon Apr 28 14:13:19 2025 UTC (3 months ago) by snw
Branches: MAIN
CVS tags: HEAD
Restructure repository

    1: DDGF0	;SFISC/MKO-SETUP, CLEANUP ;09:58 AM  9 Sep 1994
    2: 	;;21.0;VA FileMan;;Dec 28, 1994
    3: 	;Per VHA Directive 10-93-142, this routine should not be modified.
    4: 	;
    5: 	D INIT^DDGLIB0() Q:$G(DIERR)
    6: 	D SET,GETKEY
    7: 	Q
    8: 	;
    9: SET	;Setup variables
   10: 	D:$D(DT)[0 DT^DICRW
   11: 	S (DIOVRD,DDGFR)=1,DDGFREF="^TMP(""DDGF"",$J)",DDGFCHG=0
   12: 	K @DDGFREF,DDGFFM
   13: 	Q
   14: 	;
   15: END	;Clear screen, clean up variables
   16: 	I $D(DDGFFM)#2 D RECOMP
   17: KILL	;
   18: 	D:$G(DIERR) MSG^DIALOG("BW")
   19: 	X:$D(DDGLZOSF) DDGLZOSF("EON"),DDGLZOSF("TRMOFF")
   20: 	D KILL^DDGLIB0()
   21: 	K:$D(DDGFREF) @DDGFREF,DDGFREF
   22: 	K ^TMP("DDGFH",$J)
   23: 	K DDGF,DDGFBV,DDGFCHG,DDGFE,DDGFFILE,DDGFFM,DDGFLIM,DDGFMSG
   24: 	K DDGFPG,DDGFR,DDGFWID,DDGFWIDB
   25: 	K DDH
   26: 	Q
   27: 	;
   28: RECOMP	;Recompile form
   29: 	N DDGFLIST
   30: 	S DDGFLIST=$NA(^TMP("DDGFOF",$J))
   31: 	D MSG^DDGF("Recompiling ...")
   32: 	;
   33: 	D GETBLKS(+DDGFFM,DDGFLIST)
   34: 	S DDSQUIET=1 D EN^DDSZ(DDGFFM) K DDSQUIET
   35: 	I $D(@DDGFLIST) D
   36: 	. N DDGFI
   37: 	. S DDGFI=""
   38: 	. F  S DDGFI=$O(@DDGFLIST@(DDGFI)) Q:'DDGFI  D EN^DDSZ(DDGFI)
   39: 	. K @DDGFLIST
   40: 	;
   41: 	D MSG^DDGF("")
   42: 	S DX=0,DY=IOSL-1 X IOXY
   43: 	Q
   44: 	;
   45: GETBLKS(F,L)	;
   46: 	;Determine if any of the blocks loaded are
   47: 	;used on other forms.
   48: 	; L(Form#)=""        Other forms that need recompiling
   49: 	;
   50: 	N P,B
   51: 	S P=0 F  S P=$O(@DDGFREF@("F",P)) Q:'P  D
   52: 	. S B=0
   53: 	. F  S B=$O(@DDGFREF@("F",P,B)) Q:'B  D:'$D(@L@("B",B))
   54: 	.. S @L@("B",B)=""
   55: 	.. D OTHER(B,F,L)
   56: 	K @L@("B")
   57: 	Q
   58: 	;
   59: OTHER(B,F,L)	;
   60: 	;Return list L of forms other than F that use block B
   61: 	; L(Form#)=""
   62: 	N F1
   63: 	S F1=""
   64: 	F  S F1=$O(^DIST(.403,"AB",B,F1)) Q:F1=""  I F1'=F S @L@(F1)=""
   65: 	S F1="" F  S F1=$O(^DIST(.403,"AC",B,F1)) Q:F1=""  I F1'=F S @L@(F1)=""
   66: 	Q
   67: 	;
   68: GETKEY	;Get key sequences and defaults
   69: 	N AU,AD,AR,AL,F1,F2,F3,F4,I,K,N,T
   70: 	S AU=$P(DDGLKEY,U,2)
   71: 	S AD=$P(DDGLKEY,U,3)
   72: 	S AR=$P(DDGLKEY,U,4)
   73: 	S AL=$P(DDGLKEY,U,5)
   74: 	S F1=$P(DDGLKEY,U,6)
   75: 	S F2=$P(DDGLKEY,U,7)
   76: 	S F3=$P(DDGLKEY,U,8)
   77: 	S F4=$P(DDGLKEY,U,9)
   78: 	;
   79: 	F N="","S","D" D
   80: 	. S DDGF(N_"IN")="",DDGF(N_"OUT")=""
   81: 	. F I=1:1 S T=$P($T(@(N_"MAP")+I),";;",2,999) Q:T=""  D
   82: 	.. S @("K="_$P(T,";",2))
   83: 	.. I DDGF(N_"IN")'[(U_K) D
   84: 	... S DDGF(N_"IN")=DDGF(N_"IN")_U_K
   85: 	... S DDGF(N_"OUT")=DDGF(N_"OUT")_$P(T,";")_U
   86: 	. S DDGF(N_"IN")=DDGF(N_"IN")_U
   87: 	. S DDGF(N_"OUT")=$E(DDGF(N_"OUT"),1,$L(DDGF(N_"OUT"))-1)
   88: 	Q
   89: 	;
   90: MAP	;Keys for main screen
   91: 	;;LNU;AU;          line up
   92: 	;;LND;AD;          line down
   93: 	;;CHR;AR;          char right
   94: 	;;CHL;AL;          char left
   95: 	;;ELR;$C(9);       element right
   96: 	;;ELL;"Q";         element left
   97: 	;;TBR;"S";         tab right
   98: 	;;TBL;"A";         tab left
   99: 	;;EXIT;F1_"E";     exit
  100: 	;;QUIT;F1_"Q";     quit
  101: 	;;ROWCOL;"R";      row/col indicator toggle
  102: 	;;SCT;F1_AU;       top of screen
  103: 	;;SCB;F1_AD;       bottom of screen
  104: 	;;SCR;F1_AR;       right edge of screen
  105: 	;;SCL;F1_AL;       left edge of screen
  106: 	;;SAVE;F1_"S";     save changes
  107: 	;;SELECT;" ";      select an element
  108: 	;;SELECT;$C(13);   select an element
  109: 	;;SELFILE;F1_1;    select file
  110: 	;;VIEW;F1_"V";     view toggle
  111: 	;;EDIT;F3;         edit caption or data length
  112: 	;;FLDADD;F2_"F";   add a new field
  113: 	;;BKADD;F2_"B";    add a new block
  114: 	;;NXTPG;F1_F1_AD;  go to next page
  115: 	;;PRVPG;F1_F1_AU;  go to previous page
  116: 	;;CLSPG;F1_"C";    close popup page
  117: 	;;PGSEL;F1_"P";    select another page
  118: 	;;PGADD;F2_"P";    add a new page
  119: 	;;PGEDIT;F4_"P";   edit page attributes
  120: 	;;FMSEL;F1_"M";    select another form
  121: 	;;FMADD;F2_"M";    add a new form
  122: 	;;FMEDIT;F4_"M";   edit form attributes
  123: 	;;HELP;F1_"H"
  124: 	;;
  125: SMAP	;Keys for moving selected gadgets
  126: 	;;LNU;AU;          line up
  127: 	;;LND;AD;          line down
  128: 	;;CHR;AR;          char right
  129: 	;;CHL;AL;          char left
  130: 	;;TBR;$C(9);       tab right
  131: 	;;TBR;"S";          "   "
  132: 	;;TBL;"Q";         tab left
  133: 	;;TBL;"A";          "   "
  134: 	;;ROWCOL;"R";      row/col indicator toggle
  135: 	;;SCT;F1_AU;       top of screen
  136: 	;;SCB;F1_AD;       bottom of screen
  137: 	;;SCR;F1_AR;       right edge of screen
  138: 	;;SCL;F1_AL;       left edge of screen
  139: 	;;SUBPG;F1_"D";    go into a multiples pop-up page
  140: 	;;DESELECT;" ";    deselect an element
  141: 	;;DESELECT;$C(13); deselect an element
  142: 	;;EDIT;F4;         edit properties
  143: 	;;REORDER;F1_"O" ; reorder fields in block
  144: 	;;
  145: DMAP	;Keys for changing data length
  146: 	;;CHR;AR;          char right
  147: 	;;CHL;AL;          char left
  148: 	;;DONE;$C(13);     done
  149: 	;;DONE;" ";        done
  150: 	;;DONE;F3;         done
  151: 	;;

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