Return to DDGF1.m CVS log

Up to [Coherent Logic Development] / freem_fileman / USER

Restructure repository

    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.