DDS41 ;SFISC/MKO - VERIFY DATA ;21MAR2017
;;22.2;VA FileMan;**5**;Jan 05, 2016;Build 28
;;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.
;;GFT;**8,999,1004,1057**
;
N DDO,DIERR
N DDS4B,DDS4DA,DDS4DONE,DDS4ERR,DDS4FLD,DDS4OUT,DDS4PG,DDS4PG1,DDS4TP
N DDSCAP,DDSERROR,DDSFDA,DDSI,DDSKEY,DDSPID,DDSREQ
;
S DDS4OUT=$NA(@DDSREFT@("VALMSG"))
S DDS4PG=DDSPG
;
K @DDS4OUT,@DDSREFT@("MSG"),@DDSREFT@("KMSG")
;
I $G(DDSPTB)_$G(DDSREP)]"" N DIE,DDP,DDSDA,DA,DDSDL D
. S DA=+DDSDAORG,DDSDL=DDSDLORG,DDSDA=DA_"," ;GFT
. F DDSI=1:1:DDSDL S DA(DDSI)=DDSDAORG(DDSI),DDSDA=DDSDA_DA(DDSI)_","
. S DDP=$P($G(DDSFLORG),U),DIE=U_$P($G(DDSFLORG),U,2) S:DIE=U DIE=""
;
D LDALL
I $G(DIERR) D G END
. N P
. S P(1)=$P($G(^DIST(.403,+DDS,40,DDSPG,0)),U),P(2)=$P($G(^(1)),U)
. S:P(2)="" P(2)="unnamed"
. D BLD^DIALOG(3041,.P),ERR^DDSMSG
. S DDS4ERR=1
;
D LP
;
;Validate keys
S DDSKEY=1
I $D(DDSFDA) D
. S DDSKEY=$$KEYVAL^DIE("","DDSFDA",$NA(@DDSREFT@("KMSG")))
. I 'DDSKEY,$D(DDS4ERR)[0 S DDS4ERR=1 D BLD^DIALOG(3091,"","",DDS4OUT,"S")
;
S DDSPG=DDS4PG
I '$G(DDS4ERR),$G(^DIST(.403,+DDS,20))'?."^" X ^(20) ;DATA VALIDATION
I $G(@DDSREFT@("MSG"))>0!$G(DDS4ERR)!'DDSKEY D PRNT
;
END S Y='$D(DDSERROR)&'$G(DDS4ERR)&$G(DDSKEY) ;BRX-0903-10662
K @DDS4OUT,@DDSREFT@("MSG"),@DDSREFT@("KMSG")
Q
;
LDALL ;Load all pages
S DX=0,DY=IOSL-1 X IOXY
W "..."_$P(DDGLCLR,DDGLDEL) ;**'PLEASE WAIT'
S (DDSPG,DDS4PG1)=$O(^DIST(.403,+DDS,40,"B",$S($G(DDSPAGE)]"":DDSPAGE,1:1),""))
S Y=1
F D EN^DDS1(DDSPG,1) Q:$G(DIERR) S DDSPG=$$NP^DDS5(.Y) Q:DDSPG=DDS4PG1!'Y ;DDP MAY BE NULL WHEN CALLING ^DDS, SO THIS WILL CRASH @ LD+16^DDS11
Q
;
LP ;Loop through all pages/blocks
N DDP
S DX=0,DY=IOSL-1 X IOXY
W "..."_$P(DDGLCLR,DDGLDEL) ;**'VERIFYING'
;
S DDSPG=0 F S DDSPG=$O(@DDSREFT@(DDSPG)) Q:'DDSPG D
. S DDS4B=0 F S DDS4B=$O(@DDSREFT@(DDSPG,DDS4B)) Q:'DDS4B D
.. Q:$D(DDS4DONE(DDS4B)) Q:$P(@DDSREFS@(DDSPG,DDS4B),U,5)'="e"
.. S DDSPID=$S($P($G(^DIST(.403,+DDS,40,DDSPG,1)),U)]"":$P(^(1),U),1:"Page "_$P(^(0),U))
.. S DDS4DONE(DDS4B)="",DDP=$P(^DIST(.404,DDS4B,0),U,2)
.. S DDO=0 F S DDO=$O(^DIST(.404,DDS4B,40,DDO)) Q:'DDO D VF
Q
;
VF ;Check required and key fields
Q:$D(^DIST(.404,DDS4B,40,DDO,0))[0 S DDS4TP=$P(^(0),U,3)
Q:DDS4TP=1 Q:DDS4TP=4
S DDSCAP=$P(^DIST(.404,DDS4B,40,DDO,0),U,2)_$S($P(^(0),U,4)]"":" ("_$P(^(0),U,4)_")",1:"")
S DDSREQ=$P($G(^DIST(.404,DDS4B,40,DDO,4)),U)
S DDSKEY=0
;
I DDS4TP=2 N DDP D
. S DDP=0,DDS4FLD=DDO_","_DDS4B
. S:DDSCAP="" DDSCAP=$P(^DIST(.404,DDS4B,40,DDO,0),U,5)
;
E D Q:DDS4FLD'=+$P(DDS4FLD,"E")
. S DDS4FLD=$G(^DIST(.404,DDS4B,40,DDO,1))
. I $G(^DD(DDP,DDS4FLD,0))?."^" S DDS4FLD="" Q
. S:DDSCAP="" DDSCAP=$$LABEL^DIALOGZ(DDP,DDS4FLD) ;FOR SOME REASON, HE USED TO GRAB TITLE, IF PRESENT!
. S:DDSREQ="" DDSREQ=$P(^DD(DDP,DDS4FLD,0),U,2)["R"
. S DDSKEY=$D(^DD("KEY","F",DDP,DDS4FLD))>0
;
S DDS4DA=" "
DAS F S DDS4DA=$O(@DDSREFT@(DDSPG,DDS4B,DDS4DA)) Q:DDS4DA'["," D ;IGNORE "COMP MUL" NODE
. I $P(@DDSREFT@(DDSPG,DDS4B,DDS4DA),U,6)<2 D VR Q
. ;
. N DDS4PDA S DDS4PDA=DDS4DA N DDS4DA
. S DDS4DA=""
. F S DDS4DA=$O(@DDSREFT@(DDSPG,DDS4B,DDS4PDA,"B",DDS4DA)) Q:'DDS4DA D VR
Q
;
VR ;Check individual records
I $P($G(@DDSREFT@("F"_DDP,DDS4DA,DDS4FLD,"A")),U)]"" N DDSREQ S DDSREQ=$P(^("A"),U)
I 'DDSREQ,'DDSKEY Q
;
;Required WP fields (quit if mult)
I DDP,$D(@DDSREFT@("F"_DDP,DDS4DA,DDS4FLD,"M")) D:'^("M") Q
. N DDS4I,DDS4REF,DDS4VAL
. I $G(@DDSREFT@("F"_DDP,DDS4DA,DDS4FLD,"F")) S DDS4REF=$NA(^("D"))
. E S DDS4REF=$P(@DDSREFT@("F"_DDP,DDS4DA,DDS4FLD,"M"),U,2),DDS4REF=U_$E(DDS4REF,1,$L(DDS4REF)-1)_")"
. S (DDS4VAL,DDS4I)=0
. F S DDS4I=$O(@DDS4REF@(DDS4I)) Q:'DDS4I I $G(@DDS4REF@(DDS4I,0))'?." " S DDS4VAL=1 Q
. D:'DDS4VAL LDERR
;
I $G(@DDSREFT@("F"_DDP,DDS4DA,DDS4FLD,"D"))="" D LDERR Q
;
I DDSKEY,$D(@DDSREFT@("F"_DDP,DDS4DA,DDS4FLD,"F")) S DDSFDA(DDP,DDS4DA,DDS4FLD)=$G(^("D"))
Q
;
LDERR ;Call ^DIALOG to load error
N P,E
I $D(DDS4ERR)[0 S DDS4ERR=1 D BLD^DIALOG(3091,"","",DDS4OUT,"S") ;'THE DATA COULD NOT BE FILED.'
S P(1)=DDSPID,P(2)=DDSCAP
I $L(DDS4DA,",")>2
E S E=$O(@DDSREFT@("F"_DDP,"")) I E]"" S E=$O(^(E)) I E]"" ;ARE THERE MORE THAN ONE OF THESE ENTRIES?
I S P(3)=$$GET1^DIQ(DDP,DDS4DA,.01,,,"E") I P(3)]"" S P(3)="("_$$EZBLD^DIALOG(8079)_": "_P(3)_")" ;'SUBRECORD'
D BLD^DIALOG(3092,.P,"",DDS4OUT,"S") ; '|1|, |2| is a required field |3|'
Q
;
PRNT ;Print messages
N DDSABT
S (DDSABT,DX,DY)=0 X IOXY
W $P(DDGLCLR,DDGLDEL,2)
S $X=0,$Y=0
;
;Print required field messages
I $G(DDS4ERR) S DDSI=0 F S DDSI=$O(@DDS4OUT@(DDSI)) Q:'DDSI D Q:DDSABT
. D:$G(@DDS4OUT@(DDSI))]"" WLIN(^(DDSI))
;
;Print duplicate key messages
S DDSI=0 F S DDSI=$O(@DDSREFT@("KMSG","DIERR",DDSI)) Q:'DDSI D Q:DDSABT
. D WLIN(" "),WLIN(@DDSREFT@("KMSG","DIERR",DDSI,"TEXT",1))
. Q:@DDSREFT@("KMSG","DIERR",DDSI)'=740
. ;
. N DA,FIL,FILE,FLD,FLDS,FNAME,IENS,J,KEY,LEV,RNAME
. S FILE=@DDSREFT@("KMSG","DIERR",DDSI,"PARAM","FILE"),IENS=$G(^("IENS")),KEY=$G(^("KEY"))
. D FRNAME^DIKCU1(FILE,IENS,.FNAME,.RNAME,.LEV)
. ;
. I LEV D
.. S FNAME=$J("",7)_"Subfile: "_FNAME D WLIN(.FNAME,16)
.. S RNAME=$J("",8)_"Record: "_RNAME D WLIN(.RNAME,16)
. ;
. S FLDS="",J=0 F S J=$O(^DD("KEY",KEY,2,J)) Q:'J D
.. Q:'$D(^DD("KEY",KEY,2,J,0)) S FLD=$P(^(0),U),FIL=$P(^(0),U,2)
.. Q:'$D(^DD(FIL,FLD,0)) S FLDS=FLDS_$P(^(0),U)_" (#"_FLD_"), "
. D:FLDS]"" WLIN(" Key Field(s): "_$E(FLDS,1,$L(FLDS)-2),16)
;
;Print developer messages
S DDSI=0 F S DDSI=$O(@DDSREFT@("MSG",DDSI)) Q:'DDSI D Q:DDSABT
. D:@DDSREFT@("MSG",DDSI)]"" WLIN(^(DDSI))
;
D EOP
Q
;
WLIN(DDSX,DDSINDNT) ;Write a single line, wrap at word boundaries
N I
D WRAP^DIKCU2(.DDSX,IOM-1-$G(DDSINDNT),IOM-1)
S DDSX(0)=DDSX
F I=0:1 Q:'$D(DDSX(I)) D Q:DDSABT
. I $Y+4>IOSL D EOP I 'Y S DDSABT=1 Q
. W !,$J("",$S(I:$G(DDSINDNT),1:0))_DDSX(I)
Q
EOP ;Issue EOP prompt
N X
S DX=0,DY=IOSL-1 X IOXY
W $$EZBLD^DIALOG(8053) R X:DTIME ;**
S Y=X'[U&$T
I Y S (DX,DY)=0 X IOXY W $P(DDGLCLR,DDGLDEL,2) S $X=0,$Y=0
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDDS41 6389 printed Oct 16, 2024@18:43:40 Page 2
DDS41 ;SFISC/MKO - VERIFY DATA ;21MAR2017
+1 ;;22.2;VA FileMan;**5**;Jan 05, 2016;Build 28
+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 ;;GFT;**8,999,1004,1057**
+7 ;
+8 NEW DDO,DIERR
+9 NEW DDS4B,DDS4DA,DDS4DONE,DDS4ERR,DDS4FLD,DDS4OUT,DDS4PG,DDS4PG1,DDS4TP
+10 NEW DDSCAP,DDSERROR,DDSFDA,DDSI,DDSKEY,DDSPID,DDSREQ
+11 ;
+12 SET DDS4OUT=$NAME(@DDSREFT@("VALMSG"))
+13 SET DDS4PG=DDSPG
+14 ;
+15 KILL @DDS4OUT,@DDSREFT@("MSG"),@DDSREFT@("KMSG")
+16 ;
+17 IF $GET(DDSPTB)_$GET(DDSREP)]""
NEW DIE,DDP,DDSDA,DA,DDSDL
Begin DoDot:1
+18 ;GFT
SET DA=+DDSDAORG
SET DDSDL=DDSDLORG
SET DDSDA=DA_","
+19 FOR DDSI=1:1:DDSDL
SET DA(DDSI)=DDSDAORG(DDSI)
SET DDSDA=DDSDA_DA(DDSI)_","
+20 SET DDP=$PIECE($GET(DDSFLORG),U)
SET DIE=U_$PIECE($GET(DDSFLORG),U,2)
if DIE=U
SET DIE=""
End DoDot:1
+21 ;
+22 DO LDALL
+23 IF $GET(DIERR)
Begin DoDot:1
+24 NEW P
+25 SET P(1)=$PIECE($GET(^DIST(.403,+DDS,40,DDSPG,0)),U)
SET P(2)=$PIECE($GET(^(1)),U)
+26 if P(2)=""
SET P(2)="unnamed"
+27 DO BLD^DIALOG(3041,.P)
DO ERR^DDSMSG
+28 SET DDS4ERR=1
End DoDot:1
GOTO END
+29 ;
+30 DO LP
+31 ;
+32 ;Validate keys
+33 SET DDSKEY=1
+34 IF $DATA(DDSFDA)
Begin DoDot:1
+35 SET DDSKEY=$$KEYVAL^DIE("","DDSFDA",$NAME(@DDSREFT@("KMSG")))
+36 IF 'DDSKEY
IF $DATA(DDS4ERR)[0
SET DDS4ERR=1
DO BLD^DIALOG(3091,"","",DDS4OUT,"S")
End DoDot:1
+37 ;
+38 SET DDSPG=DDS4PG
+39 ;DATA VALIDATION
IF '$GET(DDS4ERR)
IF $GET(^DIST(.403,+DDS,20))'?."^"
XECUTE ^(20)
+40 IF $GET(@DDSREFT@("MSG"))>0!$GET(DDS4ERR)!'DDSKEY
DO PRNT
+41 ;
END ;BRX-0903-10662
SET Y='$DATA(DDSERROR)&'$GET(DDS4ERR)&$GET(DDSKEY)
+1 KILL @DDS4OUT,@DDSREFT@("MSG"),@DDSREFT@("KMSG")
+2 QUIT
+3 ;
LDALL ;Load all pages
+1 SET DX=0
SET DY=IOSL-1
XECUTE IOXY
+2 ;**'PLEASE WAIT'
WRITE "..."_$PIECE(DDGLCLR,DDGLDEL)
+3 SET (DDSPG,DDS4PG1)=$ORDER(^DIST(.403,+DDS,40,"B",$SELECT($GET(DDSPAGE)]"":DDSPAGE,1:1),""))
+4 SET Y=1
+5 ;DDP MAY BE NULL WHEN CALLING ^DDS, SO THIS WILL CRASH @ LD+16^DDS11
FOR
DO EN^DDS1(DDSPG,1)
if $GET(DIERR)
QUIT
SET DDSPG=$$NP^DDS5(.Y)
if DDSPG=DDS4PG1!'Y
QUIT
+6 QUIT
+7 ;
LP ;Loop through all pages/blocks
+1 NEW DDP
+2 SET DX=0
SET DY=IOSL-1
XECUTE IOXY
+3 ;**'VERIFYING'
WRITE "..."_$PIECE(DDGLCLR,DDGLDEL)
+4 ;
+5 SET DDSPG=0
FOR
SET DDSPG=$ORDER(@DDSREFT@(DDSPG))
if 'DDSPG
QUIT
Begin DoDot:1
+6 SET DDS4B=0
FOR
SET DDS4B=$ORDER(@DDSREFT@(DDSPG,DDS4B))
if 'DDS4B
QUIT
Begin DoDot:2
+7 if $DATA(DDS4DONE(DDS4B))
QUIT
if $PIECE(@DDSREFS@(DDSPG,DDS4B),U,5)'="e"
QUIT
+8 SET DDSPID=$SELECT($PIECE($GET(^DIST(.403,+DDS,40,DDSPG,1)),U)]"":$PIECE(^(1),U),1:"Page "_$PIECE(^(0),U))
+9 SET DDS4DONE(DDS4B)=""
SET DDP=$PIECE(^DIST(.404,DDS4B,0),U,2)
+10 SET DDO=0
FOR
SET DDO=$ORDER(^DIST(.404,DDS4B,40,DDO))
if 'DDO
QUIT
DO VF
End DoDot:2
End DoDot:1
+11 QUIT
+12 ;
VF ;Check required and key fields
+1 if $DATA(^DIST(.404,DDS4B,40,DDO,0))[0
QUIT
SET DDS4TP=$PIECE(^(0),U,3)
+2 if DDS4TP=1
QUIT
if DDS4TP=4
QUIT
+3 SET DDSCAP=$PIECE(^DIST(.404,DDS4B,40,DDO,0),U,2)_$SELECT($PIECE(^(0),U,4)]"":" ("_$PIECE(^(0),U,4)_")",1:"")
+4 SET DDSREQ=$PIECE($GET(^DIST(.404,DDS4B,40,DDO,4)),U)
+5 SET DDSKEY=0
+6 ;
+7 IF DDS4TP=2
NEW DDP
Begin DoDot:1
+8 SET DDP=0
SET DDS4FLD=DDO_","_DDS4B
+9 if DDSCAP=""
SET DDSCAP=$PIECE(^DIST(.404,DDS4B,40,DDO,0),U,5)
End DoDot:1
+10 ;
+11 IF '$TEST
Begin DoDot:1
+12 SET DDS4FLD=$GET(^DIST(.404,DDS4B,40,DDO,1))
+13 IF $GET(^DD(DDP,DDS4FLD,0))?."^"
SET DDS4FLD=""
QUIT
+14 ;FOR SOME REASON, HE USED TO GRAB TITLE, IF PRESENT!
if DDSCAP=""
SET DDSCAP=$$LABEL^DIALOGZ(DDP,DDS4FLD)
+15 if DDSREQ=""
SET DDSREQ=$PIECE(^DD(DDP,DDS4FLD,0),U,2)["R"
+16 SET DDSKEY=$DATA(^DD("KEY","F",DDP,DDS4FLD))>0
End DoDot:1
if DDS4FLD'=+$PIECE(DDS4FLD,"E")
QUIT
+17 ;
+18 SET DDS4DA=" "
DAS ;IGNORE "COMP MUL" NODE
FOR
SET DDS4DA=$ORDER(@DDSREFT@(DDSPG,DDS4B,DDS4DA))
if DDS4DA'[","
QUIT
Begin DoDot:1
+1 IF $PIECE(@DDSREFT@(DDSPG,DDS4B,DDS4DA),U,6)<2
DO VR
QUIT
+2 ;
+3 NEW DDS4PDA
SET DDS4PDA=DDS4DA
NEW DDS4DA
+4 SET DDS4DA=""
+5 FOR
SET DDS4DA=$ORDER(@DDSREFT@(DDSPG,DDS4B,DDS4PDA,"B",DDS4DA))
if 'DDS4DA
QUIT
DO VR
End DoDot:1
+6 QUIT
+7 ;
VR ;Check individual records
+1 IF $PIECE($GET(@DDSREFT@("F"_DDP,DDS4DA,DDS4FLD,"A")),U)]""
NEW DDSREQ
SET DDSREQ=$PIECE(^("A"),U)
+2 IF 'DDSREQ
IF 'DDSKEY
QUIT
+3 ;
+4 ;Required WP fields (quit if mult)
+5 IF DDP
IF $DATA(@DDSREFT@("F"_DDP,DDS4DA,DDS4FLD,"M"))
if '^("M")
Begin DoDot:1
+6 NEW DDS4I,DDS4REF,DDS4VAL
+7 IF $GET(@DDSREFT@("F"_DDP,DDS4DA,DDS4FLD,"F"))
SET DDS4REF=$NAME(^("D"))
+8 IF '$TEST
SET DDS4REF=$PIECE(@DDSREFT@("F"_DDP,DDS4DA,DDS4FLD,"M"),U,2)
SET DDS4REF=U_$EXTRACT(DDS4REF,1,$LENGTH(DDS4REF)-1)_")"
+9 SET (DDS4VAL,DDS4I)=0
+10 FOR
SET DDS4I=$ORDER(@DDS4REF@(DDS4I))
if 'DDS4I
QUIT
IF $GET(@DDS4REF@(DDS4I,0))'?." "
SET DDS4VAL=1
QUIT
+11 if 'DDS4VAL
DO LDERR
End DoDot:1
QUIT
+12 ;
+13 IF $GET(@DDSREFT@("F"_DDP,DDS4DA,DDS4FLD,"D"))=""
DO LDERR
QUIT
+14 ;
+15 IF DDSKEY
IF $DATA(@DDSREFT@("F"_DDP,DDS4DA,DDS4FLD,"F"))
SET DDSFDA(DDP,DDS4DA,DDS4FLD)=$GET(^("D"))
+16 QUIT
+17 ;
LDERR ;Call ^DIALOG to load error
+1 NEW P,E
+2 ;'THE DATA COULD NOT BE FILED.'
IF $DATA(DDS4ERR)[0
SET DDS4ERR=1
DO BLD^DIALOG(3091,"","",DDS4OUT,"S")
+3 SET P(1)=DDSPID
SET P(2)=DDSCAP
+4 IF $LENGTH(DDS4DA,",")>2
+5 ;ARE THERE MORE THAN ONE OF THESE ENTRIES?
IF '$TEST
SET E=$ORDER(@DDSREFT@("F"_DDP,""))
IF E]""
SET E=$ORDER(^(E))
IF E]""
+6 ;'SUBRECORD'
IF $TEST
SET P(3)=$$GET1^DIQ(DDP,DDS4DA,.01,,,"E")
IF P(3)]""
SET P(3)="("_$$EZBLD^DIALOG(8079)_": "_P(3)_")"
+7 ; '|1|, |2| is a required field |3|'
DO BLD^DIALOG(3092,.P,"",DDS4OUT,"S")
+8 QUIT
+9 ;
PRNT ;Print messages
+1 NEW DDSABT
+2 SET (DDSABT,DX,DY)=0
XECUTE IOXY
+3 WRITE $PIECE(DDGLCLR,DDGLDEL,2)
+4 SET $X=0
SET $Y=0
+5 ;
+6 ;Print required field messages
+7 IF $GET(DDS4ERR)
SET DDSI=0
FOR
SET DDSI=$ORDER(@DDS4OUT@(DDSI))
if 'DDSI
QUIT
Begin DoDot:1
+8 if $GET(@DDS4OUT@(DDSI))]""
DO WLIN(^(DDSI))
End DoDot:1
if DDSABT
QUIT
+9 ;
+10 ;Print duplicate key messages
+11 SET DDSI=0
FOR
SET DDSI=$ORDER(@DDSREFT@("KMSG","DIERR",DDSI))
if 'DDSI
QUIT
Begin DoDot:1
+12 DO WLIN(" ")
DO WLIN(@DDSREFT@("KMSG","DIERR",DDSI,"TEXT",1))
+13 if @DDSREFT@("KMSG","DIERR",DDSI)'=740
QUIT
+14 ;
+15 NEW DA,FIL,FILE,FLD,FLDS,FNAME,IENS,J,KEY,LEV,RNAME
+16 SET FILE=@DDSREFT@("KMSG","DIERR",DDSI,"PARAM","FILE")
SET IENS=$GET(^("IENS"))
SET KEY=$GET(^("KEY"))
+17 DO FRNAME^DIKCU1(FILE,IENS,.FNAME,.RNAME,.LEV)
+18 ;
+19 IF LEV
Begin DoDot:2
+20 SET FNAME=$JUSTIFY("",7)_"Subfile: "_FNAME
DO WLIN(.FNAME,16)
+21 SET RNAME=$JUSTIFY("",8)_"Record: "_RNAME
DO WLIN(.RNAME,16)
End DoDot:2
+22 ;
+23 SET FLDS=""
SET J=0
FOR
SET J=$ORDER(^DD("KEY",KEY,2,J))
if 'J
QUIT
Begin DoDot:2
+24 if '$DATA(^DD("KEY",KEY,2,J,0))
QUIT
SET FLD=$PIECE(^(0),U)
SET FIL=$PIECE(^(0),U,2)
+25 if '$DATA(^DD(FIL,FLD,0))
QUIT
SET FLDS=FLDS_$PIECE(^(0),U)_" (#"_FLD_"), "
End DoDot:2
+26 if FLDS]""
DO WLIN(" Key Field(s): "_$EXTRACT(FLDS,1,$LENGTH(FLDS)-2),16)
End DoDot:1
if DDSABT
QUIT
+27 ;
+28 ;Print developer messages
+29 SET DDSI=0
FOR
SET DDSI=$ORDER(@DDSREFT@("MSG",DDSI))
if 'DDSI
QUIT
Begin DoDot:1
+30 if @DDSREFT@("MSG",DDSI)]""
DO WLIN(^(DDSI))
End DoDot:1
if DDSABT
QUIT
+31 ;
+32 DO EOP
+33 QUIT
+34 ;
WLIN(DDSX,DDSINDNT) ;Write a single line, wrap at word boundaries
+1 NEW I
+2 DO WRAP^DIKCU2(.DDSX,IOM-1-$GET(DDSINDNT),IOM-1)
+3 SET DDSX(0)=DDSX
+4 FOR I=0:1
if '$DATA(DDSX(I))
QUIT
Begin DoDot:1
+5 IF $Y+4>IOSL
DO EOP
IF 'Y
SET DDSABT=1
QUIT
+6 WRITE !,$JUSTIFY("",$SELECT(I:$GET(DDSINDNT),1:0))_DDSX(I)
End DoDot:1
if DDSABT
QUIT
+7 QUIT
EOP ;Issue EOP prompt
+1 NEW X
+2 SET DX=0
SET DY=IOSL-1
XECUTE IOXY
+3 ;**
WRITE $$EZBLD^DIALOG(8053)
READ X:DTIME
+4 SET Y=X'[U&$TEST
+5 IF Y
SET (DX,DY)=0
XECUTE IOXY
WRITE $PIECE(DDGLCLR,DDGLDEL,2)
SET $X=0
SET $Y=0
+6 QUIT
