DDGF0 ;SFISC/MKO-SETUP, CLEANUP ;09:58 AM 9 Sep 1994
;;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.
;
D INIT^DDGLIB0() Q:$G(DIERR)
D SET,GETKEY
Q
;
SET ;Setup variables
D:$D(DT)[0 DT^DICRW
S (DIOVRD,DDGFR)=1,DDGFREF="^TMP(""DDGF"",$J)",DDGFCHG=0
K @DDGFREF,DDGFFM
Q
;
END ;Clear screen, clean up variables
I $D(DDGFFM)#2 D RECOMP
KILL ;
D:$G(DIERR) MSG^DIALOG("BW")
X:$D(DDGLZOSF) DDGLZOSF("EON"),DDGLZOSF("TRMOFF")
D KILL^DDGLIB0()
K:$D(DDGFREF) @DDGFREF,DDGFREF
K ^TMP("DDGFH",$J)
K DDGF,DDGFBV,DDGFCHG,DDGFE,DDGFFILE,DDGFFM,DDGFLIM,DDGFMSG
K DDGFPG,DDGFR,DDGFWID,DDGFWIDB
K DDH
Q
;
RECOMP ;Recompile form
N DDGFLIST
S DDGFLIST=$NA(^TMP("DDGFOF",$J))
D MSG^DDGF("Recompiling ...")
;
D GETBLKS(+DDGFFM,DDGFLIST)
S DDSQUIET=1 D EN^DDSZ(DDGFFM) K DDSQUIET
I $D(@DDGFLIST) D
. N DDGFI
. S DDGFI=""
. F S DDGFI=$O(@DDGFLIST@(DDGFI)) Q:'DDGFI D EN^DDSZ(DDGFI)
. K @DDGFLIST
;
D MSG^DDGF("")
S DX=0,DY=IOSL-1 X IOXY
Q
;
GETBLKS(F,L) ;
;Determine if any of the blocks loaded are
;used on other forms.
; L(Form#)="" Other forms that need recompiling
;
N P,B
S P=0 F S P=$O(@DDGFREF@("F",P)) Q:'P D
. S B=0
. F S B=$O(@DDGFREF@("F",P,B)) Q:'B D:'$D(@L@("B",B))
.. S @L@("B",B)=""
.. D OTHER(B,F,L)
K @L@("B")
Q
;
OTHER(B,F,L) ;
;Return list L of forms other than F that use block B
; L(Form#)=""
N F1
S F1=""
F S F1=$O(^DIST(.403,"AB",B,F1)) Q:F1="" I F1'=F S @L@(F1)=""
S F1="" F S F1=$O(^DIST(.403,"AC",B,F1)) Q:F1="" I F1'=F S @L@(F1)=""
Q
;
GETKEY ;Get key sequences and defaults
N AU,AD,AR,AL,F1,F2,F3,F4,I,K,N,T
S AU=$P(DDGLKEY,U,2)
S AD=$P(DDGLKEY,U,3)
S AR=$P(DDGLKEY,U,4)
S AL=$P(DDGLKEY,U,5)
S F1=$P(DDGLKEY,U,6)
S F2=$P(DDGLKEY,U,7)
S F3=$P(DDGLKEY,U,8)
S F4=$P(DDGLKEY,U,9)
;
F N="","S","D" D
. S DDGF(N_"IN")="",DDGF(N_"OUT")=""
. F I=1:1 S T=$P($T(@(N_"MAP")+I),";;",2,999) Q:T="" D
.. S @("K="_$P(T,";",2))
.. I DDGF(N_"IN")'[(U_K) D
... S DDGF(N_"IN")=DDGF(N_"IN")_U_K
... S DDGF(N_"OUT")=DDGF(N_"OUT")_$P(T,";")_U
. S DDGF(N_"IN")=DDGF(N_"IN")_U
. S DDGF(N_"OUT")=$E(DDGF(N_"OUT"),1,$L(DDGF(N_"OUT"))-1)
Q
;
MAP ;Keys for main screen
;;LNU;AU; line up
;;LND;AD; line down
;;CHR;AR; char right
;;CHL;AL; char left
;;ELR;$C(9); element right
;;ELL;"Q"; element left
;;TBR;"S"; tab right
;;TBL;"A"; tab left
;;EXIT;F1_"E"; exit
;;QUIT;F1_"Q"; quit
;;ROWCOL;"R"; row/col indicator toggle
;;SCT;F1_AU; top of screen
;;SCB;F1_AD; bottom of screen
;;SCR;F1_AR; right edge of screen
;;SCL;F1_AL; left edge of screen
;;SAVE;F1_"S"; save changes
;;SELECT;" "; select an element
;;SELECT;$C(13); select an element
;;SELFILE;F1_1; select file
;;VIEW;F1_"V"; view toggle
;;EDIT;F3; edit caption or data length
;;FLDADD;F2_"F"; add a new field
;;BKADD;F2_"B"; add a new block
;;NXTPG;F1_F1_AD; go to next page
;;PRVPG;F1_F1_AU; go to previous page
;;CLSPG;F1_"C"; close popup page
;;PGSEL;F1_"P"; select another page
;;PGADD;F2_"P"; add a new page
;;PGEDIT;F4_"P"; edit page attributes
;;FMSEL;F1_"M"; select another form
;;FMADD;F2_"M"; add a new form
;;FMEDIT;F4_"M"; edit form attributes
;;HELP;F1_"H"
;;
SMAP ;Keys for moving selected gadgets
;;LNU;AU; line up
;;LND;AD; line down
;;CHR;AR; char right
;;CHL;AL; char left
;;TBR;$C(9); tab right
;;TBR;"S"; " "
;;TBL;"Q"; tab left
;;TBL;"A"; " "
;;ROWCOL;"R"; row/col indicator toggle
;;SCT;F1_AU; top of screen
;;SCB;F1_AD; bottom of screen
;;SCR;F1_AR; right edge of screen
;;SCL;F1_AL; left edge of screen
;;SUBPG;F1_"D"; go into a multiples pop-up page
;;DESELECT;" "; deselect an element
;;DESELECT;$C(13); deselect an element
;;EDIT;F4; edit properties
;;REORDER;F1_"O"; reorder fields in block
;;
DMAP ;Keys for changing data length
;;CHR;AR; char right
;;CHL;AL; char left
;;DONE;$C(13); done
;;DONE;" "; done
;;DONE;F3; done
;;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDDGF0 4558 printed Apr 09, 2024@21:46:26 Page 2
DDGF0 ;SFISC/MKO-SETUP, CLEANUP ;09:58 AM 9 Sep 1994
+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 ;
+7 DO INIT^DDGLIB0()
if $GET(DIERR)
QUIT
+8 DO SET
DO GETKEY
+9 QUIT
+10 ;
SET ;Setup variables
+1 if $DATA(DT)[0
DO DT^DICRW
+2 SET (DIOVRD,DDGFR)=1
SET DDGFREF="^TMP(""DDGF"",$J)"
SET DDGFCHG=0
+3 KILL @DDGFREF,DDGFFM
+4 QUIT
+5 ;
END ;Clear screen, clean up variables
+1 IF $DATA(DDGFFM)#2
DO RECOMP
KILL ;
+1 if $GET(DIERR)
DO MSG^DIALOG("BW")
+2 if $DATA(DDGLZOSF)
XECUTE DDGLZOSF("EON")
XECUTE DDGLZOSF("TRMOFF")
+3 DO KILL^DDGLIB0()
+4 if $DATA(DDGFREF)
KILL @DDGFREF,DDGFREF
+5 KILL ^TMP("DDGFH",$JOB)
+6 KILL DDGF,DDGFBV,DDGFCHG,DDGFE,DDGFFILE,DDGFFM,DDGFLIM,DDGFMSG
+7 KILL DDGFPG,DDGFR,DDGFWID,DDGFWIDB
+8 KILL DDH
+9 QUIT
+10 ;
RECOMP ;Recompile form
+1 NEW DDGFLIST
+2 SET DDGFLIST=$NAME(^TMP("DDGFOF",$JOB))
+3 DO MSG^DDGF("Recompiling ...")
+4 ;
+5 DO GETBLKS(+DDGFFM,DDGFLIST)
+6 SET DDSQUIET=1
DO EN^DDSZ(DDGFFM)
KILL DDSQUIET
+7 IF $DATA(@DDGFLIST)
Begin DoDot:1
+8 NEW DDGFI
+9 SET DDGFI=""
+10 FOR
SET DDGFI=$ORDER(@DDGFLIST@(DDGFI))
if 'DDGFI
QUIT
DO EN^DDSZ(DDGFI)
+11 KILL @DDGFLIST
End DoDot:1
+12 ;
+13 DO MSG^DDGF("")
+14 SET DX=0
SET DY=IOSL-1
XECUTE IOXY
+15 QUIT
+16 ;
GETBLKS(F,L) ;
+1 ;Determine if any of the blocks loaded are
+2 ;used on other forms.
+3 ; L(Form#)="" Other forms that need recompiling
+4 ;
+5 NEW P,B
+6 SET P=0
FOR
SET P=$ORDER(@DDGFREF@("F",P))
if 'P
QUIT
Begin DoDot:1
+7 SET B=0
+8 FOR
SET B=$ORDER(@DDGFREF@("F",P,B))
if 'B
QUIT
if '$DATA(@L@("B",B))
Begin DoDot:2
+9 SET @L@("B",B)=""
+10 DO OTHER(B,F,L)
End DoDot:2
End DoDot:1
+11 KILL @L@("B")
+12 QUIT
+13 ;
OTHER(B,F,L) ;
+1 ;Return list L of forms other than F that use block B
+2 ; L(Form#)=""
+3 NEW F1
+4 SET F1=""
+5 FOR
SET F1=$ORDER(^DIST(.403,"AB",B,F1))
if F1=""
QUIT
IF F1'=F
SET @L@(F1)=""
+6 SET F1=""
FOR
SET F1=$ORDER(^DIST(.403,"AC",B,F1))
if F1=""
QUIT
IF F1'=F
SET @L@(F1)=""
+7 QUIT
+8 ;
GETKEY ;Get key sequences and defaults
+1 NEW AU,AD,AR,AL,F1,F2,F3,F4,I,K,N,T
+2 SET AU=$PIECE(DDGLKEY,U,2)
+3 SET AD=$PIECE(DDGLKEY,U,3)
+4 SET AR=$PIECE(DDGLKEY,U,4)
+5 SET AL=$PIECE(DDGLKEY,U,5)
+6 SET F1=$PIECE(DDGLKEY,U,6)
+7 SET F2=$PIECE(DDGLKEY,U,7)
+8 SET F3=$PIECE(DDGLKEY,U,8)
+9 SET F4=$PIECE(DDGLKEY,U,9)
+10 ;
+11 FOR N="","S","D"
Begin DoDot:1
+12 SET DDGF(N_"IN")=""
SET DDGF(N_"OUT")=""
+13 FOR I=1:1
SET T=$PIECE($TEXT(@(N_"MAP")+I),";;",2,999)
if T=""
QUIT
Begin DoDot:2
+14 SET @("K="_$PIECE(T,";",2))
+15 IF DDGF(N_"IN")'[(U_K)
Begin DoDot:3
+16 SET DDGF(N_"IN")=DDGF(N_"IN")_U_K
+17 SET DDGF(N_"OUT")=DDGF(N_"OUT")_$PIECE(T,";")_U
End DoDot:3
End DoDot:2
+18 SET DDGF(N_"IN")=DDGF(N_"IN")_U
+19 SET DDGF(N_"OUT")=$EXTRACT(DDGF(N_"OUT"),1,$LENGTH(DDGF(N_"OUT"))-1)
End DoDot:1
+20 QUIT
+21 ;
MAP ;Keys for main screen
+1 ;;LNU;AU; line up
+2 ;;LND;AD; line down
+3 ;;CHR;AR; char right
+4 ;;CHL;AL; char left
+5 ;;ELR;$C(9); element right
+6 ;;ELL;"Q"; element left
+7 ;;TBR;"S"; tab right
+8 ;;TBL;"A"; tab left
+9 ;;EXIT;F1_"E"; exit
+10 ;;QUIT;F1_"Q"; quit
+11 ;;ROWCOL;"R"; row/col indicator toggle
+12 ;;SCT;F1_AU; top of screen
+13 ;;SCB;F1_AD; bottom of screen
+14 ;;SCR;F1_AR; right edge of screen
+15 ;;SCL;F1_AL; left edge of screen
+16 ;;SAVE;F1_"S"; save changes
+17 ;;SELECT;" "; select an element
+18 ;;SELECT;$C(13); select an element
+19 ;;SELFILE;F1_1; select file
+20 ;;VIEW;F1_"V"; view toggle
+21 ;;EDIT;F3; edit caption or data length
+22 ;;FLDADD;F2_"F"; add a new field
+23 ;;BKADD;F2_"B"; add a new block
+24 ;;NXTPG;F1_F1_AD; go to next page
+25 ;;PRVPG;F1_F1_AU; go to previous page
+26 ;;CLSPG;F1_"C"; close popup page
+27 ;;PGSEL;F1_"P"; select another page
+28 ;;PGADD;F2_"P"; add a new page
+29 ;;PGEDIT;F4_"P"; edit page attributes
+30 ;;FMSEL;F1_"M"; select another form
+31 ;;FMADD;F2_"M"; add a new form
+32 ;;FMEDIT;F4_"M"; edit form attributes
+33 ;;HELP;F1_"H"
+34 ;;
SMAP ;Keys for moving selected gadgets
+1 ;;LNU;AU; line up
+2 ;;LND;AD; line down
+3 ;;CHR;AR; char right
+4 ;;CHL;AL; char left
+5 ;;TBR;$C(9); tab right
+6 ;;TBR;"S"; " "
+7 ;;TBL;"Q"; tab left
+8 ;;TBL;"A"; " "
+9 ;;ROWCOL;"R"; row/col indicator toggle
+10 ;;SCT;F1_AU; top of screen
+11 ;;SCB;F1_AD; bottom of screen
+12 ;;SCR;F1_AR; right edge of screen
+13 ;;SCL;F1_AL; left edge of screen
+14 ;;SUBPG;F1_"D"; go into a multiples pop-up page
+15 ;;DESELECT;" "; deselect an element
+16 ;;DESELECT;$C(13); deselect an element
+17 ;;EDIT;F4; edit properties
+18 ;;REORDER;F1_"O"; reorder fields in block
+19 ;;
DMAP ;Keys for changing data length
+1 ;;CHR;AR; char right
+2 ;;CHL;AL; char left
+3 ;;DONE;$C(13); done
+4 ;;DONE;" "; done
+5 ;;DONE;F3; done
+6 ;;
