Annotation of freem_fileman/DDGFPG.m, revision 1.1
1.1 ! snw 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
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>
![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to DDGFPG.m CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [Coherent Logic Development] / freem_fileman