DDGFFM ;SFISC/MKO-FORM ADD, EDIT, SELECT ;11:48 AM 20 Dec 1994
;;22.0;VA FileMan;;Mar 30, 1999
;Per VHA Directive 10-93-142, this routine should not be modified.
;
SEL ;Select another form
ADD ;Add a new form
N X,DIR0 K DDGFABT
S DDGFDY=+$G(DY),DDGFDX=+$G(DX),(DY,DX)=0 X IOXY
W $P(DDGLCLR,DDGLDEL,2)
X DDGLZOSF("EON"),DDGLZOSF("TRMOFF")
;
;Select file
FIL S DDS1="EDIT/CREATE FORM FOR" D W^DICRW K DDS1 G:Y<0 ADDQ
G:'$D(@(DIC_"0)")) ADDQ
;
;Select form
W !
S DIC("S")="I $P(^(0),U,8)=+DDGFFILE"
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"
S DDGFFILE=Y,DIC=.403,DIC(0)="QEAL",D="F"_+Y
D IX^DIC K DIC,D G:Y<0 ADDQ
S DDGFY=Y
;
;Save data for previous form
I DDGFCHG,$D(DDGFFM)#2 G:+DDGFFM=+DDGFY ADDQ D G:$G(DDGFABT) ADDQ
. N DDGFFNAM
. S DIR(0)="Y",DDGFFNAM=$P(DDGFFM,U,2)
. S DIR("A")="Save changes to form "_DDGFFNAM
. S DIR("B")="YES"
. S DIR("?",1)=" Enter 'Y' or press 'Return' to save changes."
. S DIR("?",2)=" Enter 'N' to discard changes."
. S DIR("?")=" Enter '^' to return to form "_DDGFFNAM
. W ! D ^DIR K DIR I $D(DIRUT) K DIRUT,DUOUT,DTOUT S DDGFABT=1 Q
. D SAVE^DDGFSV
;
I $D(DDGFFM)#2,+DDGFFM'=+DDGFY D RECOMP^DDGF0
;
S DDGFFM=$P(DDGFY,U,1,2)
;
;Stuff in values for form
K DR S DIE=.403,DA=+DDGFY,DDGFNEW=$P(DDGFY,U,3)
S:DDGFNEW DR="3////"_DUZ_";4///NOW"
S DR=$S($G(DR)]"":DR_";",1:"")_"5///NOW"
S:DDGFNEW DR=DR_";7////"_+DDGFFILE
D ^DIE K DIE,DA,DR,D,%DT
I DDGFNEW,$G(DUZ(0))]"" D
. S $P(^DIST(.403,+DDGFFM,0),U,2,3)=DUZ(0)_U_DUZ(0)
;
;If this is a new form, create Page 1
I DDGFNEW D
. K DD,DO
. S DIC="^DIST(.403,+DDGFFM,40,",DIC("P")=$P(^DD(.403,40,0),U,2)
. S DIC(0)="",DA(1)=+DDGFFM,X=1
. D FILE^DICN I Y=-1 K DIC,Y Q
. S DIE=DIC,DA=+Y,DR="2////1,1;7////Page 1"
. D ^DIE K DIC,DIE,DA,DR,D,Y
;
;Clear data for previous form
W $P(DDGLCLR,DDGLDEL,2)
I $D(@DDGFREF) K @DDGFREF D DESTALL^DDGLIBW
;
;Get first page, load form
S DDGFPG=$O(^DIST(.403,+DDGFFM,40,"B",""))
I DDGFPG]"" S DDGFPG=$O(^DIST(.403,+DDGFFM,40,"B",DDGFPG,""))
D PG^DDGFLOAD(+DDGFFM,DDGFPG),STATUS^DDGF
S DDGFDY=$P(DDGFLIM,U),DDGFDX=$P(DDGFLIM,U,2)
;
ADDQQ X DDGLZOSF("EOFF"),DDGLZOSF("TRMON")
D RC(DDGFDY,DDGFDX)
K DDGFABT,DDGFDY,DDGFDX,DDGFNEW,DDGFY
Q
;
ADDQ I $D(DDGFFM)#2 D REFRESH^DDGF G ADDQQ
K DDGFABT,DDGFDY,DDGFDX
Q
;
EDIT ;Invoke form to edit form
S DDGFDY=DY,DDGFDX=DX
K DDSFILE S DDSFILE=.403
S DA=+DDGFFM,DR="[DDGF FORM EDIT]",DDSPARM="KTW"
D ^DDS K DDSFILE,DR,DDSPARM
;
S $P(DDGFFM,U,2)=$P(^DIST(.403,+DDGFFM,0),U)
D REFRESH^DDGF,RC(DDGFDY,DDGFDX)
EDITQ K DDGFDY,DDGFDX
Q
;
RC(DDGFY,DDGFX) ;Update status line, reset DX and DY, move cursor
N DDGFS
I DDGFR D
. S DY=IOSL-6,DX=IOM-9,DDGFS="R"_(DDGFY+1)_",C"_(DDGFX+1)
. X IOXY W DDGFS_$J("",7-$L(DDGFS))
S DY=DDGFY,DX=DDGFX X IOXY
Q
DDGFFM ;SFISC/MKO-FORM ADD, EDIT, SELECT ;11:48 AM 20 Dec 1994
+1 ;;22.0;VA FileMan;;Mar 30, 1999
+2 ;Per VHA Directive 10-93-142, this routine should not be modified.
+3 ;
SEL ;Select another form
ADD ;Add a new form
+1 NEW X,DIR0
KILL DDGFABT
+2 SET DDGFDY=+$GET(DY)
SET DDGFDX=+$GET(DX)
SET (DY,DX)=0
XECUTE IOXY
+3 WRITE $PIECE(DDGLCLR,DDGLDEL,2)
+4 XECUTE DDGLZOSF("EON")
XECUTE DDGLZOSF("TRMOFF")
+5 ;
+6 ;Select file
FIL SET DDS1="EDIT/CREATE FORM FOR"
DO W^DICRW
KILL DDS1
IF Y<0
GOTO ADDQ
+1 IF '$DATA(@(DIC_"0)"))
GOTO ADDQ
+2 ;
+3 ;Select form
+4 WRITE !
+5 SET DIC("S")="I $P(^(0),U,8)=+DDGFFILE"
+6 IF DUZ(0)'="@"
SET 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"
+7 SET DDGFFILE=Y
SET DIC=.403
SET DIC(0)="QEAL"
SET D="F"_+Y
+8 DO IX^DIC
KILL DIC,D
IF Y<0
GOTO ADDQ
+9 SET DDGFY=Y
+10 ;
+11 ;Save data for previous form
+12 IF DDGFCHG
IF $DATA(DDGFFM)#2
IF +DDGFFM=+DDGFY
GOTO ADDQ
Begin DoDot:1
+13 NEW DDGFFNAM
+14 SET DIR(0)="Y"
SET DDGFFNAM=$PIECE(DDGFFM,U,2)
+15 SET DIR("A")="Save changes to form "_DDGFFNAM
+16 SET DIR("B")="YES"
+17 SET DIR("?",1)=" Enter 'Y' or press 'Return' to save changes."
+18 SET DIR("?",2)=" Enter 'N' to discard changes."
+19 SET DIR("?")=" Enter '^' to return to form "_DDGFFNAM
+20 WRITE !
DO ^DIR
KILL DIR
IF $DATA(DIRUT)
KILL DIRUT,DUOUT,DTOUT
SET DDGFABT=1
QUIT
+21 DO SAVE^DDGFSV
End DoDot:1
IF $GET(DDGFABT)
GOTO ADDQ
+22 ;
+23 IF $DATA(DDGFFM)#2
IF +DDGFFM'=+DDGFY
DO RECOMP^DDGF0
+24 ;
+25 SET DDGFFM=$PIECE(DDGFY,U,1,2)
+26 ;
+27 ;Stuff in values for form
+28 KILL DR
SET DIE=.403
SET DA=+DDGFY
SET DDGFNEW=$PIECE(DDGFY,U,3)
+29 IF DDGFNEW
SET DR="3////"_DUZ_";4///NOW"
+30 SET DR=$SELECT($GET(DR)]"":DR_";",1:"")_"5///NOW"
+31 IF DDGFNEW
SET DR=DR_";7////"_+DDGFFILE
+32 DO ^DIE
KILL DIE,DA,DR,D,%DT
+33 IF DDGFNEW
IF $GET(DUZ(0))]""
Begin DoDot:1
+34 SET $PIECE(^DIST(.403,+DDGFFM,0),U,2,3)=DUZ(0)_U_DUZ(0)
End DoDot:1
+35 ;
+36 ;If this is a new form, create Page 1
+37 IF DDGFNEW
Begin DoDot:1
+38 KILL DD,DO
+39 SET DIC="^DIST(.403,+DDGFFM,40,"
SET DIC("P")=$PIECE(^DD(.403,40,0),U,2)
+40 SET DIC(0)=""
SET DA(1)=+DDGFFM
SET X=1
+41 DO FILE^DICN
IF Y=-1
KILL DIC,Y
QUIT
+42 SET DIE=DIC
SET DA=+Y
SET DR="2////1,1;7////Page 1"
+43 DO ^DIE
KILL DIC,DIE,DA,DR,D,Y
End DoDot:1
+44 ;
+45 ;Clear data for previous form
+46 WRITE $PIECE(DDGLCLR,DDGLDEL,2)
+47 IF $DATA(@DDGFREF)
KILL @DDGFREF
DO DESTALL^DDGLIBW
+48 ;
+49 ;Get first page, load form
+50 SET DDGFPG=$ORDER(^DIST(.403,+DDGFFM,40,"B",""))
+51 IF DDGFPG]""
SET DDGFPG=$ORDER(^DIST(.403,+DDGFFM,40,"B",DDGFPG,""))
+52 DO PG^DDGFLOAD(+DDGFFM,DDGFPG)
DO STATUS^DDGF
+53 SET DDGFDY=$PIECE(DDGFLIM,U)
SET DDGFDX=$PIECE(DDGFLIM,U,2)
+54 ;
ADDQQ XECUTE DDGLZOSF("EOFF")
XECUTE DDGLZOSF("TRMON")
+1 DO RC(DDGFDY,DDGFDX)
+2 KILL DDGFABT,DDGFDY,DDGFDX,DDGFNEW,DDGFY
+3 QUIT
+4 ;
ADDQ IF $DATA(DDGFFM)#2
DO REFRESH^DDGF
GOTO ADDQQ
+1 KILL DDGFABT,DDGFDY,DDGFDX
+2 QUIT
+3 ;
EDIT ;Invoke form to edit form
+1 SET DDGFDY=DY
SET DDGFDX=DX
+2 KILL DDSFILE
SET DDSFILE=.403
+3 SET DA=+DDGFFM
SET DR="[DDGF FORM EDIT]"
SET DDSPARM="KTW"
+4 DO ^DDS
KILL DDSFILE,DR,DDSPARM
+5 ;
+6 SET $PIECE(DDGFFM,U,2)=$PIECE(^DIST(.403,+DDGFFM,0),U)
+7 DO REFRESH^DDGF
DO RC(DDGFDY,DDGFDX)
EDITQ KILL DDGFDY,DDGFDX
+1 QUIT
+2 ;
RC(DDGFY,DDGFX) ;Update status line, reset DX and DY, move cursor
+1 NEW DDGFS
+2 IF DDGFR
Begin DoDot:1
+3 SET DY=IOSL-6
SET DX=IOM-9
SET DDGFS="R"_(DDGFY+1)_",C"_(DDGFX+1)
+4 XECUTE IOXY
WRITE DDGFS_$JUSTIFY("",7-$LENGTH(DDGFS))
End DoDot:1
+5 SET DY=DDGFY
SET DX=DDGFX
XECUTE IOXY
+6 QUIT
