DDGFFM ;SFISC/MKO-FORM ADD, EDIT, SELECT ;8MAR2016
;;22.2;VA FileMan;;Jan 05, 2016;Build 42
;;Per VA Directive 6402, this routine should not be modified.
;;Submitted to OSEHRA 5 January 2015 by the VISTA Expertise Network.
;;Based on Medsphere Systems Corporation's MSC FileMan 1051.
;;Licensed under the terms of the Apache License, Version 2.0.
;
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=8107 D W^DICRW K DDS1 G:Y<0 ADDQ ;**CCO/NI EDIT/CREATE FORM
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
N GFT I DDGFNEW D Q:$D(GFT)
. 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
SELPAGE .S Y=^DIC(+DDGFFILE,0,"GL") I $P($G(@(Y_"0)")),U,4)<999 D I Y=1 D GFT K DDGFFM W !!,"DONE!",! Q
..N DIR S DIR(0)="Y",DIR("A")="Do you want your Form to begin with a display of all entries, for selection"
..S DIR("?")="Answer YES to save setup time!",DIR("?",1)="Your Form can automatically present a scrolling list of all entries"
..I $O(^DD(+DDGFFILE,0,"ID",0)) S DIR("?",2)="including IDENTIFIER fields"
..D ^DIR
;
;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
;
;
GFT ;BUILD A SELECTION PAGE -- called from SELPAGE above
N DO,DIC,FLD,LN,L,DLAYGO,GFTQUIT,GFTID,GFTPOS,DDGH
S (DLAYGO,DIC)=.404,X=$P(DDGFY,U,2),DIC(0)="LX",DIC("DR")="1////"_+DDGFFILE D FILE^DICN ;CREATE NEW BLOCK FOR DATA
S DDGFBLK=+Y Q:'$P(Y,U,3)
S (DLAYGO,DIC)=.404,X=$P(DDGFY,U,2)_" HEADER",DIC(0)="LX",DIC("DR")="1////"_+DDGFFILE D FILE^DICN ;CREATE NEW HEADER BLOCK
S DDGH=+Y
S FLD=0,GFTID=U,GFTPOS=2
S GFT=.01 F S FLD=FLD+1 D Q:$G(GFTQUIT) S GFT=$O(^DD(+DDGFFILE,0,"ID",GFT)) Q:'GFT
.D FIELD^DID(+DDGFFILE,GFT,"","FIELD LENGTH;LABEL","GFT(GFT)")
.S L=GFT(GFT,"LABEL") I $L(GFTID)+$L(L)+$L(GFTID,U)>74 S GFTQUIT=1,FLD=FLD-1 Q ;HEADER RESTRICTS NUMBER OF FIELDS
.S LN=GFT(GFT,"FIELD LENGTH") S:LN>74 LN=74 S GFTID(FLD)=LN,GFTPOS(FLD)=GFTPOS,GFTPOS=GFTPOS+LN+2,GFTID(FLD,1)=GFT,GFTID=GFTID_L_U
F S L=GFTPOS-79\FLD Q:L<1 S LN=0 F X=1:1:FLD D
.I GFTID(X)-1<6 Q
.S GFTID(X)=GFTID(X)-1,GFTPOS=GFTPOS-1,GFTPOS(X)=GFTPOS(X)-LN,LN=LN+1 ;TRIM FIELD LENGTHS BY 1
F X=1:1 Q:'$D(GFTID(X)) D
.S DIC="^DIST(.404,"_DDGFBLK_",40,",DLAYGO=.4044,DA(1)=DDGFBLK,DIC(0)="LX"
.S DIC("DR")="2////3;3.1////"_$P(GFTID,U,X+1)_";4////"_GFTID(X,1)_";4.1///2,"_GFTPOS(X)_";4.2///"_GFTID(X)
.D FILE^DICN ;CREATE A DATA FIELD
S DIC="^DIST(.404,"_DDGH_",40,",DA(1)=DDGH,DIC(0)="LX",X=1,DIC("DR")="2///4;4.1///1,1;4.2///80;30///S Y=$$HEADER^DDGFFM("_+DDGFFM_")"
D FILE^DICN ;CREATE THE HEADER FIELD
S GFT=^DIC(+DDGFFILE,0,"GL") I '$D(^DD(+DDGFFILE,0,"IX","B",+DDGFFILE,.01)) S GFT="F D=0:0 S D=$O("_GFT
E S GFT="S GFT="""" F S GFT=$O("_GFT_"""B"",GFT)) Q:GFT="""" F D=0:0 S D=$O("_GFT_"""B"",GFT," ;SHOW ENTRIES ALPHABETICALLY IF THERE IS A "B" X-REF
S GFT=GFT_"D)) Q:'D N Y S (Y,D0)=D "_$G(^DD(+DDGFFILE,0,"SCR"))_" X DICMX Q:'$D(D)"
S DIE=.403,DA=+DDGFFM,DR="21///1" D ^DIE ;FORM'S RECORD SELECTION PAGE=1
S DIC="^DIST(.403,"_DA_",40,1,40,",DA(2)=DA,DA(1)=1,(X,DINUM)=DDGFBLK,DIC(0)="UXL",DIC("P")=".4032IP",DLAYGO=.4032
S DIC("DR")="1///1;2///2,1;3///e;5///15;98.1///"_+DDGFFILE_";98////^S X=GFT"
D FILE^DICN ;ADD DATA BLOCK TO PAGE
S DIE="^DIST(.403,"_+DDGFFM_",40,",DR="1////"_DDGH,DA=1 D ^DIE ;ADD HEADER BLOCK POINTER
Q
;
;
N B,X,F,S,L,D,FILE,Y,FILENAME,LABEL,LINE
S X="",S=0,B=$O(^DIST(.403,FORM,"AY",1,0)) I 'B Q X
S FILE=$P(^(B),U,3) Q:'FILE
F F=0:0 S F=$O(^DIST(.403,FORM,"AY",1,B,F)) Q:'F S Y=$G(^(F,"D")) Q:'Y S:'$D(LINE) LINE=+Y Q:Y>LINE D
.S L=$P(Y,U,3) Q:'L
.S D=$P(Y,U,4),LABEL=$$LABEL^DIALOGZ(FILE,D)
.D:$L(LABEL)>L S LABEL=$E(LABEL,1,L)
..N Z,T F Z=0:0 S Z=$O(^DIST(.404,B,40,Z)) Q:'Z I $G(^(Z,1))=D S T=$P(^(0),U,5) I T]"",$L(T)<$L(LABEL) S LABEL=T Q ;TRY SHORTER 'UNIQUE NAME'
.I D=.01,$L(LABEL)+3<L S FILENAME=$$FILENAME^DIALOGZ(FILE) I $L(FILENAME)+$L(LABEL)<L S LABEL=FILENAME_" "_LABEL
.S D=$P(Y,U,2),$E(X,D,D+L-1)=LABEL
Q X
;
;
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
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDDGFFM 6493 printed Nov 22, 2024@17:52:19 Page 2
DDGFFM ;SFISC/MKO-FORM ADD, EDIT, SELECT ;8MAR2016
+1 ;;22.2;VA FileMan;;Jan 05, 2016;Build 42
+2 ;;Per VA Directive 6402, this routine should not be modified.
+3 ;;Submitted to OSEHRA 5 January 2015 by the VISTA Expertise Network.
+4 ;;Based on Medsphere Systems Corporation's MSC FileMan 1051.
+5 ;;Licensed under the terms of the Apache License, Version 2.0.
+6 ;
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 ;**CCO/NI EDIT/CREATE FORM
SET DDS1=8107
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 NEW GFT
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
SELPAGE SET Y=^DIC(+DDGFFILE,0,"GL")
IF $PIECE($GET(@(Y_"0)")),U,4)<999
Begin DoDot:2
+1 NEW DIR
SET DIR(0)="Y"
SET DIR("A")="Do you want your Form to begin with a display of all entries, for selection"
+2 SET DIR("?")="Answer YES to save setup time!"
SET DIR("?",1)="Your Form can automatically present a scrolling list of all entries"
+3 IF $ORDER(^DD(+DDGFFILE,0,"ID",0))
SET DIR("?",2)="including IDENTIFIER fields"
+4 DO ^DIR
End DoDot:2
IF Y=1
DO GFT
KILL DDGFFM
WRITE !!,"DONE!",!
QUIT
End DoDot:1
if $DATA(GFT)
QUIT
+5 ;
+6 ;Clear data for previous form
+7 WRITE $PIECE(DDGLCLR,DDGLDEL,2)
+8 IF $DATA(@DDGFREF)
KILL @DDGFREF
DO DESTALL^DDGLIBW
+9 ;
+10 ;Get first page, load form
+11 SET DDGFPG=$ORDER(^DIST(.403,+DDGFFM,40,"B",""))
+12 IF DDGFPG]""
SET DDGFPG=$ORDER(^DIST(.403,+DDGFFM,40,"B",DDGFPG,""))
+13 DO PG^DDGFLOAD(+DDGFFM,DDGFPG)
DO STATUS^DDGF
+14 SET DDGFDY=$PIECE(DDGFLIM,U)
SET DDGFDX=$PIECE(DDGFLIM,U,2)
+15 ;
ADDQQ XECUTE DDGLZOSF("EOFF")
XECUTE DDGLZOSF("TRMON")
+1 DO RC(DDGFDY,DDGFDX)
+2 KILL DDGFABT,DDGFDY,DDGFDX,DDGFNEW,DDGFY
+3 QUIT
+4 ;
+5 ;
GFT ;BUILD A SELECTION PAGE -- called from SELPAGE above
+1 NEW DO,DIC,FLD,LN,L,DLAYGO,GFTQUIT,GFTID,GFTPOS,DDGH
+2 ;CREATE NEW BLOCK FOR DATA
SET (DLAYGO,DIC)=.404
SET X=$PIECE(DDGFY,U,2)
SET DIC(0)="LX"
SET DIC("DR")="1////"_+DDGFFILE
DO FILE^DICN
+3 SET DDGFBLK=+Y
if '$PIECE(Y,U,3)
QUIT
+4 ;CREATE NEW HEADER BLOCK
SET (DLAYGO,DIC)=.404
SET X=$PIECE(DDGFY,U,2)_" HEADER"
SET DIC(0)="LX"
SET DIC("DR")="1////"_+DDGFFILE
DO FILE^DICN
+5 SET DDGH=+Y
+6 SET FLD=0
SET GFTID=U
SET GFTPOS=2
+7 SET GFT=.01
FOR
SET FLD=FLD+1
Begin DoDot:1
+8 DO FIELD^DID(+DDGFFILE,GFT,"","FIELD LENGTH;LABEL","GFT(GFT)")
+9 ;HEADER RESTRICTS NUMBER OF FIELDS
SET L=GFT(GFT,"LABEL")
IF $LENGTH(GFTID)+$LENGTH(L)+$LENGTH(GFTID,U)>74
SET GFTQUIT=1
SET FLD=FLD-1
QUIT
+10 SET LN=GFT(GFT,"FIELD LENGTH")
if LN>74
SET LN=74
SET GFTID(FLD)=LN
SET GFTPOS(FLD)=GFTPOS
SET GFTPOS=GFTPOS+LN+2
SET GFTID(FLD,1)=GFT
SET GFTID=GFTID_L_U
End DoDot:1
if $GET(GFTQUIT)
QUIT
SET GFT=$ORDER(^DD(+DDGFFILE,0,"ID",GFT))
if 'GFT
QUIT
+11 FOR
SET L=GFTPOS-79\FLD
if L<1
QUIT
SET LN=0
FOR X=1:1:FLD
Begin DoDot:1
+12 IF GFTID(X)-1<6
QUIT
+13 ;TRIM FIELD LENGTHS BY 1
SET GFTID(X)=GFTID(X)-1
SET GFTPOS=GFTPOS-1
SET GFTPOS(X)=GFTPOS(X)-LN
SET LN=LN+1
End DoDot:1
+14 FOR X=1:1
if '$DATA(GFTID(X))
QUIT
Begin DoDot:1
+15 SET DIC="^DIST(.404,"_DDGFBLK_",40,"
SET DLAYGO=.4044
SET DA(1)=DDGFBLK
SET DIC(0)="LX"
+16 SET DIC("DR")="2////3;3.1////"_$PIECE(GFTID,U,X+1)_";4////"_GFTID(X,1)_";4.1///2,"_GFTPOS(X)_";4.2///"_GFTID(X)
+17 ;CREATE A DATA FIELD
DO FILE^DICN
End DoDot:1
+18 SET DIC="^DIST(.404,"_DDGH_",40,"
SET DA(1)=DDGH
SET DIC(0)="LX"
SET X=1
SET DIC("DR")="2///4;4.1///1,1;4.2///80;30///S Y=$$HEADER^DDGFFM("_+DDGFFM_")"
+19 ;CREATE THE HEADER FIELD
DO FILE^DICN
+20 SET GFT=^DIC(+DDGFFILE,0,"GL")
IF '$DATA(^DD(+DDGFFILE,0,"IX","B",+DDGFFILE,.01))
SET GFT="F D=0:0 S D=$O("_GFT
+21 ;SHOW ENTRIES ALPHABETICALLY IF THERE IS A "B" X-REF
IF '$TEST
SET GFT="S GFT="""" F S GFT=$O("_GFT_"""B"",GFT)) Q:GFT="""" F D=0:0 S D=$O("_GFT_"""B"",GFT,"
+22 SET GFT=GFT_"D)) Q:'D N Y S (Y,D0)=D "_$GET(^DD(+DDGFFILE,0,"SCR"))_" X DICMX Q:'$D(D)"
+23 ;FORM'S RECORD SELECTION PAGE=1
SET DIE=.403
SET DA=+DDGFFM
SET DR="21///1"
DO ^DIE
+24 SET DIC="^DIST(.403,"_DA_",40,1,40,"
SET DA(2)=DA
SET DA(1)=1
SET (X,DINUM)=DDGFBLK
SET DIC(0)="UXL"
SET DIC("P")=".4032IP"
SET DLAYGO=.4032
+25 SET DIC("DR")="1///1;2///2,1;3///e;5///15;98.1///"_+DDGFFILE_";98////^S X=GFT"
+26 ;ADD DATA BLOCK TO PAGE
DO FILE^DICN
+27 ;ADD HEADER BLOCK POINTER
SET DIE="^DIST(.403,"_+DDGFFM_",40,"
SET DR="1////"_DDGH
SET DA=1
DO ^DIE
+28 QUIT
+29 ;
+30 ;
+1 NEW B,X,F,S,L,D,FILE,Y,FILENAME,LABEL,LINE
+2 SET X=""
SET S=0
SET B=$ORDER(^DIST(.403,FORM,"AY",1,0))
IF 'B
QUIT X
+3 SET FILE=$PIECE(^(B),U,3)
if 'FILE
QUIT
+4 FOR F=0:0
SET F=$ORDER(^DIST(.403,FORM,"AY",1,B,F))
if 'F
QUIT
SET Y=$GET(^(F,"D"))
if 'Y
QUIT
if '$DATA(LINE)
SET LINE=+Y
if Y>LINE
QUIT
Begin DoDot:1
+5 SET L=$PIECE(Y,U,3)
if 'L
QUIT
+6 SET D=$PIECE(Y,U,4)
SET LABEL=$$LABEL^DIALOGZ(FILE,D)
+7 if $LENGTH(LABEL)>L
Begin DoDot:2
+8 ;TRY SHORTER 'UNIQUE NAME'
NEW Z,T
FOR Z=0:0
SET Z=$ORDER(^DIST(.404,B,40,Z))
if 'Z
QUIT
IF $GET(^(Z,1))=D
SET T=$PIECE(^(0),U,5)
IF T]""
IF $LENGTH(T)<$LENGTH(LABEL)
SET LABEL=T
QUIT
End DoDot:2
SET LABEL=$EXTRACT(LABEL,1,L)
+9 IF D=.01
IF $LENGTH(LABEL)+3<L
SET FILENAME=$$FILENAME^DIALOGZ(FILE)
IF $LENGTH(FILENAME)+$LENGTH(LABEL)<L
SET LABEL=FILENAME_" "_LABEL
+10 SET D=$PIECE(Y,U,2)
SET $EXTRACT(X,D,D+L-1)=LABEL
End DoDot:1
+11 QUIT X
+12 ;
+13 ;
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
