DDS41 ;SFISC/MKO-VERIFY DATA ;21SEP2006
;;22.0;VA FileMan;**8,151**;Mar 30, 1999;Build 10
;Per VHA Directive 2004-038, this routine should not be modified.
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_","
. 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 ;PAGE COULD NOT BE LOADED
. 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)
I $G(@DDSREFT@("MSG"))>0!$G(DDS4ERR)!'DDSKEY D PRNT
;
END S Y='$D(DDSERROR)&'$G(DDS4ERR)&$G(DDSKEY)
K @DDS4OUT,@DDSREFT@("MSG"),@DDSREFT@("KMSG")
Q
;
LDALL ;Load all pages
S DX=0,DY=IOSL-1 X IOXY
W "Please wait. Loading all pages ..."_$P(DDGLCLR,DDGLDEL)
S (DDSPG,DDS4PG1)=$O(^DIST(.403,+DDS,40,"B",$S($G(DDSPAGE)]"":DDSPAGE,1:1),""))
S Y=1
F D ^DDS1(DDSPG) Q:$G(DIERR) S DDSPG=$$NP^DDS5(.Y) Q:DDSPG=DDS4PG1!'Y
Q
;
LP ;Loop through all pages/blocks
N DDP
S DX=0,DY=IOSL-1 X IOXY
W "Verifying ..."_$P(DDGLCLR,DDGLDEL)
;
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=$S($G(^DD(DDP,DDS4FLD,.1))]"":^(.1),1:$P(^(0),U))
. S:DDSREQ="" DDSREQ=$P(^DD(DDP,DDS4FLD,0),U,2)["R"
. S DDSKEY=$D(^DD("KEY","F",DDP,DDS4FLD))>0
;
S DDS4DA=" "
F S DDS4DA=$O(@DDSREFT@(DDSPG,DDS4B,DDS4DA)) Q:DDS4DA="" D
. 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
I $D(DDS4ERR)[0 S DDS4ERR=1 D BLD^DIALOG(3091,"","",DDS4OUT,"S")
S P(1)=DDSPID,P(2)=DDSCAP,P(3)=""
I $L(DDS4DA,",")>2 D
. N Y,C
. S P(3)=$P(@(@DDSREFT@(DDSPG,DDS4B,$G(DDS4PDA,DDS4DA),"GL")_+DDS4DA_",0)"),U)
. Q:P(3)=""
. S Y=P(3),C=$P(^DD(DDP,.01,0),U,2) D Y^DIQ S P(3)=Y
. S P(3)="(Subrecord: "_P(3)_")"
D BLD^DIALOG(3092,.P,"",DDS4OUT,"S")
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
R "Press RETURN to continue: ",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
DDS41 ;SFISC/MKO-VERIFY DATA ;21SEP2006
+1 ;;22.0;VA FileMan;**8,151**;Mar 30, 1999;Build 10
+2 ;Per VHA Directive 2004-038, this routine should not be modified.
+3 NEW DDO,DIERR
+4 NEW DDS4B,DDS4DA,DDS4DONE,DDS4ERR,DDS4FLD,DDS4OUT,DDS4PG,DDS4PG1,DDS4TP
+5 NEW DDSCAP,DDSERROR,DDSFDA,DDSI,DDSKEY,DDSPID,DDSREQ
+6 ;
+7 SET DDS4OUT=$NAME(@DDSREFT@("VALMSG"))
+8 SET DDS4PG=DDSPG
+9 ;
+10 KILL @DDS4OUT,@DDSREFT@("MSG"),@DDSREFT@("KMSG")
+11 ;
+12 IF $GET(DDSPTB)_$GET(DDSREP)]""
NEW DIE,DDP,DDSDA,DA,DDSDL
Begin DoDot:1
+13 SET DA=DDSDAORG
SET DDSDL=DDSDLORG
SET DDSDA=DA_","
+14 FOR DDSI=1:1:DDSDL
SET DA(DDSI)=DDSDAORG(DDSI)
SET DDSDA=DDSDA_DA(DDSI)_","
+15 SET DDP=$PIECE($GET(DDSFLORG),U)
SET DIE=U_$PIECE($GET(DDSFLORG),U,2)
IF DIE=U
SET DIE=""
End DoDot:1
+16 ;
+17 DO LDALL
+18 IF $GET(DIERR)
Begin DoDot:1
+19 NEW P
+20 SET P(1)=$PIECE($GET(^DIST(.403,+DDS,40,DDSPG,0)),U)
SET P(2)=$PIECE($GET(^(1)),U)
+21 IF P(2)=""
SET P(2)="unnamed"
+22 ;PAGE COULD NOT BE LOADED
DO BLD^DIALOG(3041,.P)
DO ERR^DDSMSG
+23 SET DDS4ERR=1
End DoDot:1
GOTO END
+24 ;
+25 DO LP
+26 ;
+27 ;Validate keys
+28 SET DDSKEY=1
+29 IF $DATA(DDSFDA)
Begin DoDot:1
+30 SET DDSKEY=$$KEYVAL^DIE("","DDSFDA",$NAME(@DDSREFT@("KMSG")))
+31 IF 'DDSKEY
IF $DATA(DDS4ERR)[0
SET DDS4ERR=1
DO BLD^DIALOG(3091,"","",DDS4OUT,"S")
End DoDot:1
+32 ;
+33 SET DDSPG=DDS4PG
+34 IF '$GET(DDS4ERR)
IF $GET(^DIST(.403,+DDS,20))'?."^"
XECUTE ^(20)
+35 IF $GET(@DDSREFT@("MSG"))>0!$GET(DDS4ERR)!'DDSKEY
DO PRNT
+36 ;
END 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 WRITE "Please wait. Loading all pages ..."_$PIECE(DDGLCLR,DDGLDEL)
+3 SET (DDSPG,DDS4PG1)=$ORDER(^DIST(.403,+DDS,40,"B",$SELECT($GET(DDSPAGE)]"":DDSPAGE,1:1),""))
+4 SET Y=1
+5 FOR
DO ^DDS1(DDSPG)
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 WRITE "Verifying ..."_$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 IF DDSCAP=""
SET DDSCAP=$SELECT($GET(^DD(DDP,DDS4FLD,.1))]"":^(.1),1:$PIECE(^(0),U))
+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=" "
+19 FOR
SET DDS4DA=$ORDER(@DDSREFT@(DDSPG,DDS4B,DDS4DA))
IF DDS4DA=""
QUIT
Begin DoDot:1
+20 IF $PIECE(@DDSREFT@(DDSPG,DDS4B,DDS4DA),U,6)<2
DO VR
QUIT
+21 ;
+22 NEW DDS4PDA
SET DDS4PDA=DDS4DA
NEW DDS4DA
+23 SET DDS4DA=""
+24 FOR
SET DDS4DA=$ORDER(@DDSREFT@(DDSPG,DDS4B,DDS4PDA,"B",DDS4DA))
IF 'DDS4DA
QUIT
DO VR
End DoDot:1
+25 QUIT
+26 ;
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
+2 IF $DATA(DDS4ERR)[0
SET DDS4ERR=1
DO BLD^DIALOG(3091,"","",DDS4OUT,"S")
+3 SET P(1)=DDSPID
SET P(2)=DDSCAP
SET P(3)=""
+4 IF $LENGTH(DDS4DA,",")>2
Begin DoDot:1
+5 NEW Y,C
+6 SET P(3)=$PIECE(@(@DDSREFT@(DDSPG,DDS4B,$GET(DDS4PDA,DDS4DA),"GL")_+DDS4DA_",0)"),U)
+7 IF P(3)=""
QUIT
+8 SET Y=P(3)
SET C=$PIECE(^DD(DDP,.01,0),U,2)
DO Y^DIQ
SET P(3)=Y
+9 SET P(3)="(Subrecord: "_P(3)_")"
End DoDot:1
+10 DO BLD^DIALOG(3092,.P,"",DDS4OUT,"S")
+11 QUIT
+12 ;
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 READ "Press RETURN to continue: ",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
