Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: DDGFPG

DDGFPG.m

Go to the documentation of this file. 
  1. DDGFPG ;SFISC/MKO-ADD A NEW PAGE ;2:26 PM  13 Sep 1995
  1.  ;;22.0;VA FileMan;;Mar 30, 1999
  1.  ;Per VHA Directive 10-93-142, this routine should not be modified.
  1.  ;
  1. ADD ;Invoke forms to add a new page
  1.  S DDGFDY=DY,DDGFDX=DX K DDGFPNUM
  1.  ;
  1.  ;Ask for new page number
  1.  S DDSFILE=.403,DDSFILE(1)=.4031
  1.  S DA(1)=+DDGFFM,DA="",DR="[DDGF PAGE ADD]",DDSPARM="KTW"
  1.  D ^DDS K DDSFILE,DA,DR,DDSPARM
  1.  ;
  1.  G:$D(DDGFPNUM)[0 ADDQ
  1.  ;
  1.  ;Ask 'are you sure' page should be added
  1.  K DDGFANS
  1.  S DDSFILE=.403,DDSFILE(1)=.4031
  1.  S DR="[DDGF PAGE ADD]",DA(1)=+DDGFFM,DA="",DDSPARM="KTW",DDSPAGE=11
  1.  D ^DDS K DDSFILE,DA,DR,DDSPARM,DDSPAGE
  1.  ;
  1.  I '$G(DDGFANS) K DDGFANS G ADDQ
  1.  K DDGFANS
  1.  ;
  1.  ;Add page to form
  1.  S DIC="^DIST(.403,+DDGFFM,40,",DIC(0)="L",DA(1)=+DDGFFM
  1.  S DIC("P")=$P(^DD(.403,40,0),U,2),X=DDGFPNUM
  1.  K DD,DO D FILE^DICN K DIC,DA,X G:Y=-1 ADDQ
  1.  S DDGFPG=+Y
  1.  ;
  1.  ;Stuff in values for coordinates and name
  1.  S DIE="^DIST(.403,"_+DDGFFM_",40,",DA(1)=+DDGFFM,DA=DDGFPG
  1.  S DR="2////1,1;7////Page "_DDGFPNUM
  1.  D ^DIE K DIE,DA,DR
  1.  ;
  1.  K DDGFPNUM
  1.  D LOADPG
  1.  S DDGFNEW=1
  1.  G EDIT
  1.  ;
  1. ADDQ D REFRESH^DDGF,RC(DDGFDY,DDGFDX)
  1.  K DDGFPNUM,DDGFDY,DDGFDX
  1.  Q
  1.  ;
  1. EDIT ;Invoke form to edit a page
  1.  ;Input:  DDGFNEW (optional)
  1.  ;  Set by ADD to indicate this is a brand new page.
  1.  ;
  1.  S DDGFDY=DY,DDGFDX=DX
  1.  S DDGFND=@DDGFREF@("F",DDGFPG)
  1.  S (DDGFTLC,DDGFTLC0)=$P(DDGFND,U)+1_","_($P(DDGFND,U,2)+1)
  1.  S (DDGFLRC,DDGFLRC0)=$S($P(DDGFND,U,3)]"":$P(DDGFND,U,3)+1_","_($P(DDGFND,U,4)+1),1:"")
  1.  S (DDGFPNM,DDGFPNM0)=$P(DDGFND,U,5)
  1.  S DDGFPAR=$P($G(^DIST(.403,+DDGFFM,40,DDGFPG,1)),U,2)
  1.  ;
  1.  S DDSFILE=.403,DDSFILE(1)=.4031,DDSPARM="KTW"
  1.  S DA(1)=+DDGFFM,DA=DDGFPG,DR="[DDGF PAGE EDIT]"
  1.  D ^DDS K DDSFILE,DA,DR,DDSPARM
  1.  ;
  1.  S DDGFND=$G(^DIST(.403,+DDGFFM,40,DDGFPG,0))
  1.  ;
  1.  ;If page was deleted, destroy windows and set new page
  1.  I DDGFND="" D  Q:DDGFE
  1.  . I $D(DDGFWID)#2,$$EXIST^DDGLIBW(DDGFWID) D DESTROY^DDGLIBW(DDGFWID)
  1.  . I $D(DDGFWIDB)#2,$$EXIST^DDGLIBW(DDGFWIDB) D DESTROY^DDGLIBW(DDGFWIDB)
  1.  . K @DDGFREF@("F",DDGFPG),@DDGFREF@("RC",DDGFWID),@DDGFREF@("BKRC",DDGFWIDB)
  1.  . I $D(@DDGFREF@("ASUB","B",DDGFPG)) D DEL^DDGFASUB(DDGFPG)
  1.  . S DDGFPG=$O(^DIST(.403,+DDGFFM,40,"B",""))
  1.  . S:DDGFPG]"" DDGFPG=$O(^DIST(.403,+DDGFFM,40,"B",DDGFPG,""))
  1.  . D LOADPG,REFRESH^DDGF,RC(DDGFDY,DDGFDX)
  1.  ;
  1.  E  D
  1.  . S:DDGFPNM'=DDGFPNM0 $P(@DDGFREF@("F",DDGFPG),U,5)=DDGFPNM,$P(^(DDGFPG),U,7)=1,DDGFCHG=1
  1.  . D:DDGFPAR'=$P($G(^DIST(.403,+DDGFFM,40,DDGFPG,1)),U,2) EDIT^DDGFASUB(DDGFPG)
  1.  . I DDGFTLC'=DDGFTLC0!(DDGFLRC'=DDGFLRC0) D
  1.  .. 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"))
  1.  .. D STATUS^DDGF,RC($P(DDGFLIM,U),$P(DDGFLIM,U,2))
  1.  . E  D REFRESH^DDGF,RC(DDGFDY,DDGFDX)
  1.  ;
  1.  K DDGFDX,DDGFDY,DDGFND,DDGFNEW
  1.  K DDGFLRC,DDGFLRC0,DDGFPOP,DDGFPOP0,DDGFTLC,DDGFTLC0
  1.  K DDGFPAR,DDGFPNM,DDGFPNM0
  1.  Q
  1.  ;
  1. PGSEL ;Select a new page
  1.  S DDGFDY=DY,DDGFDX=DX,DDGFPAGE=DDGFPG
  1.  ;
  1.  S DDSFILE=.403,DDSFILE(1)=.4031
  1.  S DR="[DDGF PAGE SELECT]",DDSPARM="KTW"
  1.  D ^DDS
  1.  K DDSFILE,DA,DR,DDSPAGE,DDSPARM
  1.  ;
  1.  I DDGFPAGE]"",DDGFPAGE'=DDGFPG S DDGFPG=DDGFPAGE D LOADPG
  1.  ;
  1.  D REFRESH^DDGF,RC(DDGFDY,DDGFDX)
  1.  K DDGFPAGE,DDGFDY,DDGFDX
  1.  Q
  1.  ;
  1. NXTPRV(F) ;Go to page
  1.  ;F=1:next page; -1:previous page
  1.  S DDGFPAGE=$P($G(^DIST(.403,+DDGFFM,40,DDGFPG,0)),U,$S($G(F)=-1:5,1:4))
  1.  G:DDGFPAGE="" NXTPRVQ
  1.  S DDGFPAGE=$O(^DIST(.403,+DDGFFM,40,"B",DDGFPAGE,""))
  1.  G:$D(^DIST(.403,+DDGFFM,40,+DDGFPAGE,0))[0!(DDGFPAGE=DDGFPG) NXTPRVQ
  1.  ;
  1.  S DDGFPG=DDGFPAGE
  1.  D LOADPG,REFRESH^DDGF,RC(DDGFDY,DDGFDX)
  1. NXTPRVQ K DDGFPAGE,DDGFDY,DDGFDX
  1.  Q
  1.  ;
  1. CLSPG ;Close page
  1.  Q:$G(DDGLSCR)'>1
  1.  D CLOSE^DDGLIBW(DDGFWID)
  1.  S DDGFPG=$E(DDGLSCR(DDGLSCR),2,999)
  1.  D PG^DDGFLOAD(+DDGFFM,DDGFPG,1)
  1.  D STATUS^DDGF,RC($P(DDGFLIM,U),$P(DDGFLIM,U,2))
  1.  Q
  1.  ;
  1. SUBPG ;Go into subpage
  1.  I $D(@DDGFREF@("ASUB",DDGFPG,B,F))#2 S DDGFSUBP=^(F)
  1.  E  D
  1.  . S DDGFSUBP=+$P($G(^DIST(.404,B,40,F,7)),U,2)
  1.  . S DDGFSUBP=+$O(^DIST(.403,+DDGFFM,40,"B",DDGFSUBP,""))
  1.  ;
  1.  I $D(^DIST(.403,+DDGFFM,40,DDGFSUBP,0))[0 W $C(7) K DDGFSUBP Q
  1.  I DDGFSUBP=DDGFPG K DDGFSUBP Q
  1.  S DDGFE=1
  1.  Q
  1.  ;
  1. SUBPG1 S DDGFPG=DDGFSUBP K DDGFSUBP
  1.  D PG^DDGFLOAD(+DDGFFM,DDGFPG)
  1.  D STATUS^DDGF,RC($P(DDGFLIM,U),$P(DDGFLIM,U,2))
  1.  Q
  1.  ;
  1. LOADPG ;Load new page
  1.  D PG^DDGFLOAD(+DDGFFM,DDGFPG,1)
  1.  S DDGFDY=$P(DDGFLIM,U),DDGFDX=$P(DDGFLIM,U,2)
  1.  Q
  1.  ;
  1. RC(DDGFY,DDGFX) ;Update status line, reset DX and DY, move cursor
  1.  N S
  1.  I DDGFR D
  1.  . S DY=IOSL-6,DX=IOM-9,S="R"_(DDGFY+1)_",C"_(DDGFX+1)
  1.  . X IOXY W S_$J("",7-$L(S))
  1.  S DY=DDGFY,DX=DDGFX X IOXY
  1.  Q