Return to DDGFPG.m CVS log

Up to [Coherent Logic Development] / freem_fileman / USER

Restructure repository

    1: DDGFPG	;SFISC/MKO-ADD A NEW PAGE ;01:48 PM  22 Nov 1994
    2: 	;;21.0;VA FileMan;;Dec 28, 1994
    3: 	;Per VHA Directive 10-93-142, this routine should not be modified.
    4: 	;
    5: ADD	;Invoke forms to add a new page
    6: 	S DDGFDY=DY,DDGFDX=DX K DDGFPNUM
    7: 	;
    8: 	;Ask for new page number
    9: 	S DDSFILE=.403,DDSFILE(1)=.4031
   10: 	S DA(1)=+DDGFFM,DA="",DR="[DDGF PAGE ADD]",DDSPARM="KTW"
   11: 	D ^DDS K DDSFILE,DA,DR,DDSPARM
   12: 	;
   13: 	G:$D(DDGFPNUM)[0 ADDQ
   14: 	;
   15: 	;Ask 'are you sure' page should be added
   16: 	K DDGFANS
   17: 	S DDSFILE=.403,DDSFILE(1)=.4031
   18: 	S DR="[DDGF PAGE ADD]",DA(1)=+DDGFFM,DA="",DDSPARM="KTW",DDSPAGE=11
   19: 	D ^DDS K DDSFILE,DA,DR,DDSPARM,DDSPAGE
   20: 	;
   21: 	I '$G(DDGFANS) K DDGFANS G ADDQ
   22: 	K DDGFANS
   23: 	;
   24: 	;Add page to form
   25: 	S DIC="^DIST(.403,+DDGFFM,40,",DIC(0)="L",DA(1)=+DDGFFM
   26: 	S DIC("P")=$P(^DD(.403,40,0),U,2),X=DDGFPNUM
   27: 	D FILE^DICN K DIC,DA,X G:Y=-1 ADDQ
   28: 	S DDGFPG=+Y
   29: 	;
   30: 	;Stuff in values for coordinates and name
   31: 	S DIE="^DIST(.403,"_+DDGFFM_",40,",DA(1)=+DDGFFM,DA=DDGFPG
   32: 	S DR="2////1,1;7////Page "_DDGFPNUM
   33: 	D ^DIE K DIE,DA,DR
   34: 	;
   35: 	K DDGFPNUM
   36: 	D LOADPG
   37: 	S DDGFNEW=1
   38: 	G EDIT
   39: 	;
   40: ADDQ	D REFRESH^DDGF,RC(DDGFDY,DDGFDX)
   41: 	K DDGFPNUM,DDGFDY,DDGFDX
   42: 	Q
   43: 	;
   44: EDIT	;Invoke form to edit a page
   45: 	;Input:  DDGFNEW (optional)
   46: 	;  Set by ADD to indicate this is a brand new page.
   47: 	;
   48: 	S DDGFDY=DY,DDGFDX=DX
   49: 	S DDGFND=@DDGFREF@("F",DDGFPG)
   50: 	S (DDGFTLC,DDGFTLC0)=$P(DDGFND,U)+1_","_($P(DDGFND,U,2)+1)
   51: 	S (DDGFLRC,DDGFLRC0)=$S($P(DDGFND,U,3)]"":$P(DDGFND,U,3)+1_","_($P(DDGFND,U,4)+1),1:"")
   52: 	S (DDGFPNM,DDGFPNM0)=$P(DDGFND,U,5)
   53: 	S DDGFPAR=$P($G(^DIST(.403,+DDGFFM,40,DDGFPG,1)),U,2)
   54: 	;
   55: 	S DDSFILE=.403,DDSFILE(1)=.4031,DDSPARM="KTW"
   56: 	S DA(1)=+DDGFFM,DA=DDGFPG,DR="[DDGF PAGE EDIT]"
   57: 	D ^DDS K DDSFILE,DA,DR,DDSPARM
   58: 	;
   59: 	S DDGFND=$G(^DIST(.403,+DDGFFM,40,DDGFPG,0))
   60: 	;
   61: 	;If page was deleted, destroy windows and set new page
   62: 	I DDGFND="" D  Q:DDGFE
   63: 	. I $D(DDGFWID)#2,$$EXIST^DDGLIBW(DDGFWID) D DESTROY^DDGLIBW(DDGFWID)
   64: 	. I $D(DDGFWIDB)#2,$$EXIST^DDGLIBW(DDGFWIDB) D DESTROY^DDGLIBW(DDGFWIDB)
   65: 	. K @DDGFREF@("F",DDGFPG),@DDGFREF@("RC",DDGFWID),@DDGFREF@("BKRC",DDGFWIDB)
   66: 	. I $D(@DDGFREF@("ASUB","B",DDGFPG)) D DEL^DDGFASUB(DDGFPG)
   67: 	. S DDGFPG=$O(^DIST(.403,+DDGFFM,40,"B",""))
   68: 	. S:DDGFPG]"" DDGFPG=$O(^DIST(.403,+DDGFFM,40,"B",DDGFPG,""))
   69: 	. D LOADPG,REFRESH^DDGF,RC(DDGFDY,DDGFDX)
   70: 	;
   71: 	E  D
   72: 	. S:DDGFPNM'=DDGFPNM0 $P(@DDGFREF@("F",DDGFPG),U,5)=DDGFPNM,$P(^(DDGFPG),U,7)=1,DDGFCHG=1
   73: 	. D:DDGFPAR'=$P($G(^DIST(.403,+DDGFFM,40,DDGFPG,1)),U,2) EDIT^DDGFASUB(DDGFPG)
   74: 	. I DDGFTLC'=DDGFTLC0!(DDGFLRC'=DDGFLRC0) D
   75: 	.. D PAGE^DDGFUPDP($P(DDGFTLC,",")-1,$P(DDGFTLC,",",2)-1,$S(DDGFLRC]"":$P(DDGFLRC,",")-1,1:""),$S(DDGFLRC]"":$P(DDGFLRC,",",2)-1,1:""),$S(DDGFTLC=DDGFTLC0:"PBRC",1:"PTOP"))
   76: 	.. D STATUS^DDGF,RC($P(DDGFLIM,U),$P(DDGFLIM,U,2))
   77: 	. E  D REFRESH^DDGF,RC(DDGFDY,DDGFDX)
   78: 	;
   79: 	K DDGFDX,DDGFDY,DDGFND,DDGFNEW
   80: 	K DDGFLRC,DDGFLRC0,DDGFPOP,DDGFPOP0,DDGFTLC,DDGFTLC0
   81: 	K DDGFPAR,DDGFPNM,DDGFPNM0
   82: 	Q
   83: 	;
   84: PGSEL	;Select a new page
   85: 	S DDGFDY=DY,DDGFDX=DX,DDGFPAGE=DDGFPG
   86: 	;
   87: 	S DDSFILE=.403,DDSFILE(1)=.4031
   88: 	S DR="[DDGF PAGE SELECT]",DDSPARM="KTW"
   89: 	D ^DDS
   90: 	K DDSFILE,DA,DR,DDSPAGE,DDSPARM
   91: 	;
   92: 	I DDGFPAGE]"",DDGFPAGE'=DDGFPG S DDGFPG=DDGFPAGE D LOADPG
   93: 	;
   94: 	D REFRESH^DDGF,RC(DDGFDY,DDGFDX)
   95: 	K DDGFPAGE,DDGFDY,DDGFDX
   96: 	Q
   97: 	;
   98: NXTPRV(F)	;Go to page
   99: 	;F=1:next page; -1:previous page
  100: 	S DDGFPAGE=$P($G(^DIST(.403,+DDGFFM,40,DDGFPG,0)),U,$S($G(F)=-1:5,1:4))
  101: 	G:DDGFPAGE="" NXTPRVQ
  102: 	S DDGFPAGE=$O(^DIST(.403,+DDGFFM,40,"B",DDGFPAGE,""))
  103: 	G:$D(^DIST(.403,+DDGFFM,40,+DDGFPAGE,0))[0!(DDGFPAGE=DDGFPG) NXTPRVQ
  104: 	;
  105: 	S DDGFPG=DDGFPAGE
  106: 	D LOADPG,REFRESH^DDGF,RC(DDGFDY,DDGFDX)
  107: NXTPRVQ	K DDGFPAGE,DDGFDY,DDGFDX
  108: 	Q
  109: 	;
  110: CLSPG	;Close page
  111: 	Q:$G(DDGLSCR)'>1
  112: 	D CLOSE^DDGLIBW(DDGFWID)
  113: 	S DDGFPG=$E(DDGLSCR(DDGLSCR),2,999)
  114: 	D PG^DDGFLOAD(+DDGFFM,DDGFPG,1)
  115: 	D STATUS^DDGF,RC($P(DDGFLIM,U),$P(DDGFLIM,U,2))
  116: 	Q
  117: 	;
  118: SUBPG	;Go into subpage
  119: 	I $D(@DDGFREF@("ASUB",DDGFPG,B,F))#2 S DDGFSUBP=^(F)
  120: 	E  D
  121: 	. S DDGFSUBP=+$P($G(^DIST(.404,B,40,F,7)),U,2)
  122: 	. S DDGFSUBP=+$O(^DIST(.403,+DDGFFM,40,"B",DDGFSUBP,""))
  123: 	;
  124: 	I $D(^DIST(.403,+DDGFFM,40,DDGFSUBP,0))[0 W $C(7) K DDGFSUBP Q
  125: 	I DDGFSUBP=DDGFPG K DDGFSUBP Q
  126: 	S DDGFE=1
  127: 	Q
  128: 	;
  129: SUBPG1	S DDGFPG=DDGFSUBP K DDGFSUBP
  130: 	D PG^DDGFLOAD(+DDGFFM,DDGFPG)
  131: 	D STATUS^DDGF,RC($P(DDGFLIM,U),$P(DDGFLIM,U,2))
  132: 	Q
  133: 	;
  134: LOADPG	;Load new page
  135: 	D PG^DDGFLOAD(+DDGFFM,DDGFPG,1)
  136: 	S DDGFDY=$P(DDGFLIM,U),DDGFDX=$P(DDGFLIM,U,2)
  137: 	Q
  138: 	;
  139: RC(DDGFY,DDGFX)	;Update status line, reset DX and DY, move cursor
  140: 	N S
  141: 	I DDGFR D
  142: 	. S DY=IOSL-6,DX=IOM-9,S="R"_(DDGFY+1)_",C"_(DDGFX+1)
  143: 	. X IOXY W S_$J("",7-$L(S))
  144: 	S DY=DDGFY,DX=DDGFX X IOXY
  145: 	Q