| 1 | DDGFFM ;SFISC/MKO-FORM ADD, EDIT, SELECT ;11:48 AM  20 Dec 1994
 | 
|---|
| 2 |  ;;22.0;VA FileMan;;Mar 30, 1999
 | 
|---|
| 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
 | 
|---|