| 1 | DDGF0 ;SFISC/MKO-SETUP, CLEANUP ;09:58 AM  9 Sep 1994
 | 
|---|
| 2 |  ;;22.0;VA FileMan;;Mar 30, 1999
 | 
|---|
| 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 |  ;;
 | 
|---|