Return to DDGFFM.m CVS log

Up to [Coherent Logic Development] / freem_fileman / USER

Restructure repository

    1: DDGFFM	;SFISC/MKO-FORM ADD, EDIT, SELECT ;11:48 AM  20 Dec 1994
    2: 	;;21.0;VA FileMan;;Dec 28, 1994
    3: 	;Per VHA Directive 10-93-142, this routine should not be modified.
    4: 	;
    5: SEL	;Select another form
    6: ADD	;Add a new form
    7: 	N X,DIR0 K DDGFABT
    8: 	S DDGFDY=+$G(DY),DDGFDX=+$G(DX),(DY,DX)=0 X IOXY
    9: 	W $P(DDGLCLR,DDGLDEL,2)
   10: 	X DDGLZOSF("EON"),DDGLZOSF("TRMOFF")
   11: 	;
   12: 	;Select file
   13: FIL	S DDS1="EDIT/CREATE FORM FOR" D W^DICRW K DDS1 G:Y<0 ADDQ
   14: 	G:'$D(@(DIC_"0)")) ADDQ
   15: 	;
   16: 	;Select form
   17: 	W !
   18: 	S DIC("S")="I $P(^(0),U,8)=+DDGFFILE"
   19: 	I DUZ(0)'="@" S DIC("S")=DIC("S")_" N DDSI F DDSI=1:1:$L($P(^(0),U,3)) I DUZ(0)[$E($P(^(0),U,3),DDSI) Q"
   20: 	S DDGFFILE=Y,DIC=.403,DIC(0)="QEAL",D="F"_+Y
   21: 	D IX^DIC K DIC,D G:Y<0 ADDQ
   22: 	S DDGFY=Y
   23: 	;
   24: 	;Save data for previous form
   25: 	I DDGFCHG,$D(DDGFFM)#2 G:+DDGFFM=+DDGFY ADDQ D  G:$G(DDGFABT) ADDQ
   26: 	. N DDGFFNAM
   27: 	. S DIR(0)="Y",DDGFFNAM=$P(DDGFFM,U,2)
   28: 	. S DIR("A")="Save changes to form "_DDGFFNAM
   29: 	. S DIR("B")="YES"
   30: 	. S DIR("?",1)="  Enter 'Y' or press 'Return' to save changes."
   31: 	. S DIR("?",2)="  Enter 'N' to discard changes."
   32: 	. S DIR("?")="  Enter '^' to return to form "_DDGFFNAM
   33: 	. W ! D ^DIR K DIR I $D(DIRUT) K DIRUT,DUOUT,DTOUT S DDGFABT=1 Q
   34: 	. D SAVE^DDGFSV
   35: 	;
   36: 	I $D(DDGFFM)#2,+DDGFFM'=+DDGFY D RECOMP^DDGF0
   37: 	;
   38: 	S DDGFFM=$P(DDGFY,U,1,2)
   39: 	;
   40: 	;Stuff in values for form
   41: 	K DR S DIE=.403,DA=+DDGFY,DDGFNEW=$P(DDGFY,U,3)
   42: 	S:DDGFNEW DR="3////"_DUZ_";4///NOW"
   43: 	S DR=$S($G(DR)]"":DR_";",1:"")_"5///NOW"
   44: 	S:DDGFNEW DR=DR_";7////"_+DDGFFILE
   45: 	D ^DIE K DIE,DA,DR,D,%DT
   46: 	I DDGFNEW,$G(DUZ(0))]"" D
   47: 	. S $P(^DIST(.403,+DDGFFM,0),U,2,3)=DUZ(0)_U_DUZ(0)
   48: 	;
   49: 	;If this is a new form, create Page 1
   50: 	I DDGFNEW D
   51: 	. K DD,DO
   52: 	. S DIC="^DIST(.403,+DDGFFM,40,",DIC("P")=$P(^DD(.403,40,0),U,2)
   53: 	. S DIC(0)="",DA(1)=+DDGFFM,X=1
   54: 	. D FILE^DICN I Y=-1 K DIC,Y Q
   55: 	. S DIE=DIC,DA=+Y,DR="2////1,1;7////Page 1"
   56: 	. D ^DIE K DIC,DIE,DA,DR,D,Y
   57: 	;
   58: 	;Clear data for previous form
   59: 	W $P(DDGLCLR,DDGLDEL,2)
   60: 	I $D(@DDGFREF) K @DDGFREF D DESTALL^DDGLIBW
   61: 	;
   62: 	;Get first page, load form
   63: 	S DDGFPG=$O(^DIST(.403,+DDGFFM,40,"B",""))
   64: 	I DDGFPG]"" S DDGFPG=$O(^DIST(.403,+DDGFFM,40,"B",DDGFPG,""))
   65: 	D PG^DDGFLOAD(+DDGFFM,DDGFPG),STATUS^DDGF
   66: 	S DDGFDY=$P(DDGFLIM,U),DDGFDX=$P(DDGFLIM,U,2)
   67: 	;
   68: ADDQQ	X DDGLZOSF("EOFF"),DDGLZOSF("TRMON")
   69: 	D RC(DDGFDY,DDGFDX)
   70: 	K DDGFABT,DDGFDY,DDGFDX,DDGFNEW,DDGFY
   71: 	Q
   72: 	;
   73: ADDQ	I $D(DDGFFM)#2 D REFRESH^DDGF G ADDQQ
   74: 	K DDGFABT,DDGFDY,DDGFDX
   75: 	Q
   76: 	;
   77: EDIT	;Invoke form to edit form
   78: 	S DDGFDY=DY,DDGFDX=DX
   79: 	K DDSFILE S DDSFILE=.403
   80: 	S DA=+DDGFFM,DR="[DDGF FORM EDIT]",DDSPARM="KTW"
   81: 	D ^DDS K DDSFILE,DR,DDSPARM
   82: 	;
   83: 	S $P(DDGFFM,U,2)=$P(^DIST(.403,+DDGFFM,0),U)
   84: 	D REFRESH^DDGF,RC(DDGFDY,DDGFDX)
   85: EDITQ	K DDGFDY,DDGFDX
   86: 	Q
   87: 	;
   88: RC(DDGFY,DDGFX)	;Update status line, reset DX and DY, move cursor
   89: 	N DDGFS
   90: 	I DDGFR D
   91: 	. S DY=IOSL-6,DX=IOM-9,DDGFS="R"_(DDGFY+1)_",C"_(DDGFX+1)
   92: 	. X IOXY W DDGFS_$J("",7-$L(DDGFS))
   93: 	S DY=DDGFY,DX=DDGFX X IOXY
   94: 	Q