DIC1 ;SFISC/GFT/TKW-READ X, SHOW CHOICES ;29DEC2013
;;22.2;VA FileMan;**20**;Jan 05, 2016;Build 2
;;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.
;
K DUOUT,DTOUT N DD,DIY,DISUB,DIPRMT
D GETFA(.DIC,.DO)
N DIPRMT D GETPRMT^DIC11(.DIC,.DO,.DINDEX,.DIPRMT)
B I $D(DIC("B")) D
. N B S B(1)=$G(DIC("B")) M B=DIC("B")
. N DIGBL,DINONULL S DIGBL=DIC_""""_DINDEX_"""",DINONULL=1
. F DISUB=1:1:DINDEX("#") D S:B]"" DIY(DISUB)=B
. . S B=$G(B(DISUB)) I B="" S DINONULL=0 Q
. . S X="" S:DINONULL X=$O(@(DIGBL_",B)"))
. . S B=$S($D(^(B)):B,$F(X,B)-1=$L(B):X,$D(@(DIC_"B,0)")):$P(^(0),U),1:B)
. . N B1 S B1=B I "VPD"[DINDEX(DISUB,"TYPE") D
. . . I B D Q:$D(DIY(DISUB,"EXT"))
. . . . N TYPE S TYPE=DINDEX(DISUB,"TYPE")
. . . . I TYPE="D" Q:B'?7N.1".".N
. . . . I TYPE="P" Q:B'?.N.1".".N
. . . . I TYPE="V" Q:B'?1.N.1".".N1";".E
. . . . S DIY(DISUB,"EXT")=$$EXT^DIC2(DINDEX(DISUB,"FILE"),DINDEX(DISUB,"FIELD"),B)
. . . . S:TYPE="P" B=DIY(DISUB,"EXT") Q
. . . D CHK^DIE(DINDEX(DISUB,"FILE"),DINDEX(DISUB,"FIELD"),"",B,.B1,"DIERROR") S:$G(DIERROR) B1=B
. . . K DIERROR,DIERR Q
. . S:DINONULL DIGBL=DIGBL_","_$S(+$P(B1,"E")=B1:B1,1:""""_B1_"""")
. . Q
. Q
PROMPT ; Prompt user for lookup values
D PROMPT^DIC11
Q
;
;
GETFA(DIC,DO) ; Get file attributes
; DIC is open global reference, output same as documented in DO^DIC1.
D DO Q
;
DO ; GET FILE ATTR
Q:$D(DO(2)) I $D(@(DIC_"0)")) S DO=^(0)
E S DO="0^-1" I $D(DIC("P")) S DO=U_DIC("P"),^(0)=DO
EGP I $P(DO,U,2)>1.9 S $P(DO,U)=$$FILENAME^DIALOGZ(+$P(DO,U,2)) ;**CCO/NI PROMPT FILE NAME and following line
DO2 S DO(2)=$P(DO,U,2) I DO?1"^".E S $P(DO,U)=$O(^DD(+DO(2),0,"NM",0)) ;p20 files<1.9 might not have a ^DIC(+DO(2))
I DO(2)["s",$D(^DD(+DO(2),0,"SCR")) S DO("SCR")=^("SCR")
Q:$D(DIC("W")) Q:DO(2)'["I" Q:'$D(^DD(+DO(2),0,"ID"))
S DIC("W")=""
P ; Add code to DIC("W") to display identifiers on pointed-to files
I DO(2)["P" D WOV,PTRID^DIC5(.DO,.DIC) Q
N % S %=0
;
W F S %=$O(^DD(+DO(2),0,"ID",%)) D:%]"" Q:%=""
. N X S X=^DD(+DO(2),0,"ID",%) Q:X="W """""
. I $L(DIC("W"))+$L(X)>224 D WOV S %="" Q
. I DIC("W")="" S DIC("W")="N C,DINAME"
. S DIC("W")=DIC("W")_" W "" "" "_X
. Q
Q
;
WOV S DIC("W")="N DIFILEI,DIEN,DIGBL S DIFILEI=+DO(2),DIEN=Y,DIGBL=DIC D WOV^DICQ1"
Q
;
RENUM ;
D GETFA(.DIC,.DO)
I '$D(DF),X?.NP,^DD(+DO(2),.01,0)["DINUM",$D(@(DIC_"X)")) D Q:Y>0
. S Y=X D S^DIC3 I $T N DZ D ADDKEY^DIC3,GOT^DIC2 Q
. S Y=-1 Q
D F^DIC Q
;
DT S DST=DST_$$DATE^DIUTL(%) ;**CCO/NI DATE FORMAT
I '$D(DDS) W DST S DST=""
Q
;
Y ; Display a list of entries
N DD,DDD,DDC,DDH,DIOUT S DIY="",DIOUT=0,DD=DS("DD")
I DD=0,DIC(0)["T",DIC(0)["E" D DSPH^DIC0
F S DD=$O(DS(DD)) Q:'DD D Q:DIOUT
. S DDH=DD-1,DIYX=0,DS("DD")=DD
. I DIC(0)["E" W:'$D(DDS) !?5,DD,?9 D
. . N Y S Y=+DS(DD)
. . D E Q
. I DIC(0)["Y" Q:DD<DS D
. . F Y=DS:-1 Q:'$G(DS(Y)) S Y(+DS(Y))=""
. . Q
. I DIC(0)'["E"!(DIC(0)["Y") S DS(0)="1^",DIOUT=1,DIY="" Q ;IMPORTANT! STOPS FURTHER LOOKUP
. I DS>DD Q:DD#5
. S DIOUT=1
. I $D(DDS) S DDD=2,DDC=5 D LIST^DDSU K DDD,DDC
. I '$D(DDS) D
. . I DS>DD W !,$$EZBLD^DIALOG(8087,$S(DIC(0)["T":"'^^' to exit all lists,",1:"")) ;**PATCH 122
. . N R S R(1)=$O(DS(0)),R(2)=DD W !,$$EZBLD^DIALOG(8088,.R) R DIY:$S($D(DTIME):DTIME,1:300) S:'$T DTOUT=1 Q ;"CHOOSE 1-5" or whatever
. I $G(DTOUT) W $C(7) S X="" Q
. I DIY[U!($G(DUOUT)) S DUOUT=1,X=U D Q
. . I DIY?1"^^".E,DIC(0)["T" S DIROUT=1 Q
. . I DIY?1"^".E,DIC(0)["E",DIC(0)'["T" S DIROUT=1 Q
. Q
I DIY?1.N.1".".N D I DIY,DIY'>DD,$G(DS(DIY)) S Y=+DS(DIY) D GOT S DS(0)=1_"^"_+Y Q
. S:($L($P(DIY,"."))>25!($L($P(DIY,".",2))>25)) DIY="-1" Q
I $L(DIY)>25 S DIY=-1
N I S I=$S($G(DUOUT):"1^U",$G(DTOUT):"1^T",DIY?1."?":"1^?",DIY:1,1:"")
I 'I,DIY]"",+$P(DIY,"E")'=DIY,'$G(DICR),DINDEX("#")=1 S I="2^"_DIY
Q:'I
S DS(0)=I,Y=-1
I DIY?1."?" D
. I (DIC(0)_$G(DICR(1,0)))'["A",$D(DICRS) Q
. N X,Y,DS D DSPHLP^DICQ(.DIC,.DIFILEI,.DINDEX,"?",1)
K DIY,DIYX Q
;
E S DST="" D
. I DIC(0)["U" ;Q I DO NOT KNOW WHY THIS 'QUIT' WAS THERE --GFT
. I $O(DS(DD,0)) S DST=$$BLDDSP(.DS,DD) Q
. S %=$S($G(DILONGX):DICR(DILONGX,"ORG"),$G(DINDEX("IXTYPE"))'="S":$P(X,U),1:"")
. S %=%_$P(DS(DD),U,2,9)_$S($G(DIYX(DD)):DIY(DD),1:"")
. I ($G(DITRANX)!($G(DICRS))),$G(DINDEX(1,"TRANOUT"))]"",%]"" D Q
. . N X S X=% X DINDEX(1,"TRANOUT") S DST=$G(X) Q
. I +$P(%,"E")=%,$D(DIDA) D DT Q
. I $G(DICRS),$G(DINDEX("IXTYPE"))="R" D
. . N F1,F2 S F1=$G(DINDEX(1,"FILE")),F2=$G(DINDEX(1,"FIELD"))
. . I F1,F2 S %=$$EXT^DIC2(F1,F2,%,"h")
. . Q
. S DST=% Q
I DIC(0)["s" S DIC(0)=$TR(DIC(0),"s")
I $D(DS(DD,"K")) S %=$G(DIX) M DIX=DS(DD) S DIX=%
S DIY=$S($G(DIYX(DD)):"",1:DIY(DD)) D WO^DIC2 Q
;
BLDDSP(DS,DD,DINDXFL,DIYX,DIY,DICRS) ; Build display of index values
N X,I S X=""
F I=0:0 S I=$O(DS(DD,I)) Q:'I D
. I $L(X)+$L(DS(DD,I))>240 Q
. I I=1,$G(DINDXFL) S X=$P(DS(1),U,2,99)_$S($G(DIYX(1)):$G(DIY(1)),1:"") Q
. I I=1,$G(DICRS) Q
. S X=X_$P(" ^",U,I>1)_DS(DD,I) Q
Q X
;
GOT ; Set data for single entry selected by user.
N I,J,K
I DIY(DIY)="" S DIY(DIY)=$P($G(@(DIC_"Y,0)")),U)
S:$D(DDS) DST=X_$P(DS(DIY),U,2,9)_$S($G(DIYX(DIY)):$G(DIY(DIY)),1:"")
S K=$O(DIVPSEL("A"),-1) I K]"" S DIVPSEL(K)=Y
I $G(DIFINDR) D Q
. S:$D(DDS) DS(0,"DST")=DST
. S DS(0,"Y")=+DS(DIY),DS(0,"X")=X_$P(DS(DIY),"^",2),DS(0,"DIYX")=$G(DIYX(DIY)),DS(0,"DIY")=DIY(DIY)
. M DS(0,1)=DS(DIY)
. Q
I $G(DIYX(DIY)) K DIYX S DIY(DIY)=$P($G(@(DIC_"Y,0)")),U)
D C^DIC2 Q
;
OK ;
S %=1 I $G(DS)=1 S DST=" ...OK" D Y^DICN W:'$D(DDS) !
I %>0 Q:%=1 D S X=$G(DIX),Y=-1 Q ;%=1=Yes, %=2=No
. I $G(DICR) S DICR(DICR,31.2)=+Y ;Preserve IEN for future reference
. I +$G(DS) K DS S (DS,DS(0),DS("DD"))=0 ;ReInit Display array
. Q
I %=0 W !?4,$$EZBLD^DIALOG(8040),! G OK ;User asked for Help
I %=-1,$D(DTOUT) S DIROUT=1 ;User TIMED Out; DTOUT set in DICN
I %=-1,'$D(DTOUT) S (DUOUT,DIROUT)=1 ;User single up-arrowed out
BAD S Y=-1
I $G(%Y)?1"^^".E S (DIROUT,DUOUT)=1
S DS(0)=$S($G(DTOUT):"1^T",$G(DUOUT):"1^U",$G(%)=-1:"1^U",1:"1^") Q
MIX ;
N DID S DID=D_"^-1",DID(1)=2
N D S D=$P(DID,U)
G IX^DIC
;
;#8042 Select |filename|:
;#8040 Answer with 'Yes' or 'No'
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDIC1 6493 printed Oct 16, 2024@18:45:51 Page 2
DIC1 ;SFISC/GFT/TKW-READ X, SHOW CHOICES ;29DEC2013
+1 ;;22.2;VA FileMan;**20**;Jan 05, 2016;Build 2
+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 ;
+7 KILL DUOUT,DTOUT
NEW DD,DIY,DISUB,DIPRMT
+8 DO GETFA(.DIC,.DO)
+9 NEW DIPRMT
DO GETPRMT^DIC11(.DIC,.DO,.DINDEX,.DIPRMT)
B IF $DATA(DIC("B"))
Begin DoDot:1
+1 NEW B
SET B(1)=$GET(DIC("B"))
MERGE B=DIC("B")
+2 NEW DIGBL,DINONULL
SET DIGBL=DIC_""""_DINDEX_""""
SET DINONULL=1
+3 FOR DISUB=1:1:DINDEX("#")
Begin DoDot:2
+4 SET B=$GET(B(DISUB))
IF B=""
SET DINONULL=0
QUIT
+5 SET X=""
if DINONULL
SET X=$ORDER(@(DIGBL_",B)"))
+6 SET B=$SELECT($DATA(^(B)):B,$FIND(X,B)-1=$LENGTH(B):X,$DATA(@(DIC_"B,0)")):$PIECE(^(0),U),1:B)
+7 NEW B1
SET B1=B
IF "VPD"[DINDEX(DISUB,"TYPE")
Begin DoDot:3
+8 IF B
Begin DoDot:4
+9 NEW TYPE
SET TYPE=DINDEX(DISUB,"TYPE")
+10 IF TYPE="D"
if B'?7N.1".".N
QUIT
+11 IF TYPE="P"
if B'?.N.1".".N
QUIT
+12 IF TYPE="V"
if B'?1.N.1".".N1";".E
QUIT
+13 SET DIY(DISUB,"EXT")=$$EXT^DIC2(DINDEX(DISUB,"FILE"),DINDEX(DISUB,"FIELD"),B)
+14 if TYPE="P"
SET B=DIY(DISUB,"EXT")
QUIT
End DoDot:4
if $DATA(DIY(DISUB,"EXT"))
QUIT
+15 DO CHK^DIE(DINDEX(DISUB,"FILE"),DINDEX(DISUB,"FIELD"),"",B,.B1,"DIERROR")
if $GET(DIERROR)
SET B1=B
+16 KILL DIERROR,DIERR
QUIT
End DoDot:3
+17 if DINONULL
SET DIGBL=DIGBL_","_$SELECT(+$PIECE(B1,"E")=B1:B1,1:""""_B1_"""")
+18 QUIT
End DoDot:2
if B]""
SET DIY(DISUB)=B
+19 QUIT
End DoDot:1
PROMPT ; Prompt user for lookup values
+1 DO PROMPT^DIC11
+2 QUIT
+3 ;
+4 ;
GETFA(DIC,DO) ; Get file attributes
+1 ; DIC is open global reference, output same as documented in DO^DIC1.
+2 DO DO
QUIT
+3 ;
DO ; GET FILE ATTR
+1 if $DATA(DO(2))
QUIT
IF $DATA(@(DIC_"0)"))
SET DO=^(0)
+2 IF '$TEST
SET DO="0^-1"
IF $DATA(DIC("P"))
SET DO=U_DIC("P")
SET ^(0)=DO
EGP ;**CCO/NI PROMPT FILE NAME and following line
IF $PIECE(DO,U,2)>1.9
SET $PIECE(DO,U)=$$FILENAME^DIALOGZ(+$PIECE(DO,U,2))
DO2 ;p20 files<1.9 might not have a ^DIC(+DO(2))
SET DO(2)=$PIECE(DO,U,2)
IF DO?1"^".E
SET $PIECE(DO,U)=$ORDER(^DD(+DO(2),0,"NM",0))
+1 IF DO(2)["s"
IF $DATA(^DD(+DO(2),0,"SCR"))
SET DO("SCR")=^("SCR")
+2 if $DATA(DIC("W"))
QUIT
if DO(2)'["I"
QUIT
if '$DATA(^DD(+DO(2),0,"ID"))
QUIT
+3 SET DIC("W")=""
P ; Add code to DIC("W") to display identifiers on pointed-to files
+1 IF DO(2)["P"
DO WOV
DO PTRID^DIC5(.DO,.DIC)
QUIT
+2 NEW %
SET %=0
+3 ;
W FOR
SET %=$ORDER(^DD(+DO(2),0,"ID",%))
if %]""
Begin DoDot:1
+1 NEW X
SET X=^DD(+DO(2),0,"ID",%)
if X="W """""
QUIT
+2 IF $LENGTH(DIC("W"))+$LENGTH(X)>224
DO WOV
SET %=""
QUIT
+3 IF DIC("W")=""
SET DIC("W")="N C,DINAME"
+4 SET DIC("W")=DIC("W")_" W "" "" "_X
+5 QUIT
End DoDot:1
if %=""
QUIT
+6 QUIT
+7 ;
WOV SET DIC("W")="N DIFILEI,DIEN,DIGBL S DIFILEI=+DO(2),DIEN=Y,DIGBL=DIC D WOV^DICQ1"
+1 QUIT
+2 ;
RENUM ;
+1 DO GETFA(.DIC,.DO)
+2 IF '$DATA(DF)
IF X?.NP
IF ^DD(+DO(2),.01,0)["DINUM"
IF $DATA(@(DIC_"X)"))
Begin DoDot:1
+3 SET Y=X
DO S^DIC3
IF $TEST
NEW DZ
DO ADDKEY^DIC3
DO GOT^DIC2
QUIT
+4 SET Y=-1
QUIT
End DoDot:1
if Y>0
QUIT
+5 DO F^DIC
QUIT
+6 ;
DT ;**CCO/NI DATE FORMAT
SET DST=DST_$$DATE^DIUTL(%)
+1 IF '$DATA(DDS)
WRITE DST
SET DST=""
+2 QUIT
+3 ;
Y ; Display a list of entries
+1 NEW DD,DDD,DDC,DDH,DIOUT
SET DIY=""
SET DIOUT=0
SET DD=DS("DD")
+2 IF DD=0
IF DIC(0)["T"
IF DIC(0)["E"
DO DSPH^DIC0
+3 FOR
SET DD=$ORDER(DS(DD))
if 'DD
QUIT
Begin DoDot:1
+4 SET DDH=DD-1
SET DIYX=0
SET DS("DD")=DD
+5 IF DIC(0)["E"
if '$DATA(DDS)
WRITE !?5,DD,?9
Begin DoDot:2
+6 NEW Y
SET Y=+DS(DD)
+7 DO E
QUIT
End DoDot:2
+8 IF DIC(0)["Y"
if DD<DS
QUIT
Begin DoDot:2
+9 FOR Y=DS:-1
if '$GET(DS(Y))
QUIT
SET Y(+DS(Y))=""
+10 QUIT
End DoDot:2
+11 ;IMPORTANT! STOPS FURTHER LOOKUP
IF DIC(0)'["E"!(DIC(0)["Y")
SET DS(0)="1^"
SET DIOUT=1
SET DIY=""
QUIT
+12 IF DS>DD
if DD#5
QUIT
+13 SET DIOUT=1
+14 IF $DATA(DDS)
SET DDD=2
SET DDC=5
DO LIST^DDSU
KILL DDD,DDC
+15 IF '$DATA(DDS)
Begin DoDot:2
+16 ;**PATCH 122
IF DS>DD
WRITE !,$$EZBLD^DIALOG(8087,$SELECT(DIC(0)["T":"'^^' to exit all lists,",1:""))
+17 ;"CHOOSE 1-5" or whatever
NEW R
SET R(1)=$ORDER(DS(0))
SET R(2)=DD
WRITE !,$$EZBLD^DIALOG(8088,.R)
READ DIY:$SELECT($DATA(DTIME):DTIME,1:300)
if '$TEST
SET DTOUT=1
QUIT
End DoDot:2
+18 IF $GET(DTOUT)
WRITE $CHAR(7)
SET X=""
QUIT
+19 IF DIY[U!($GET(DUOUT))
SET DUOUT=1
SET X=U
Begin DoDot:2
+20 IF DIY?1"^^".E
IF DIC(0)["T"
SET DIROUT=1
QUIT
+21 IF DIY?1"^".E
IF DIC(0)["E"
IF DIC(0)'["T"
SET DIROUT=1
QUIT
End DoDot:2
QUIT
+22 QUIT
End DoDot:1
if DIOUT
QUIT
+23 IF DIY?1.N.1".".N
Begin DoDot:1
+24 if ($LENGTH($PIECE(DIY,"."))>25!($LENGTH($PIECE(DIY,".",2))>25))
SET DIY="-1"
QUIT
End DoDot:1
IF DIY
IF DIY'>DD
IF $GET(DS(DIY))
SET Y=+DS(DIY)
DO GOT
SET DS(0)=1_"^"_+Y
QUIT
+25 IF $LENGTH(DIY)>25
SET DIY=-1
+26 NEW I
SET I=$SELECT($GET(DUOUT):"1^U",$GET(DTOUT):"1^T",DIY?1."?":"1^?",DIY:1,1:"")
+27 IF 'I
IF DIY]""
IF +$PIECE(DIY,"E")'=DIY
IF '$GET(DICR)
IF DINDEX("#")=1
SET I="2^"_DIY
+28 if 'I
QUIT
+29 SET DS(0)=I
SET Y=-1
+30 IF DIY?1."?"
Begin DoDot:1
+31 IF (DIC(0)_$GET(DICR(1,0)))'["A"
IF $DATA(DICRS)
QUIT
+32 NEW X,Y,DS
DO DSPHLP^DICQ(.DIC,.DIFILEI,.DINDEX,"?",1)
End DoDot:1
+33 KILL DIY,DIYX
QUIT
+34 ;
E SET DST=""
Begin DoDot:1
+1 ;Q I DO NOT KNOW WHY THIS 'QUIT' WAS THERE --GFT
IF DIC(0)["U"
+2 IF $ORDER(DS(DD,0))
SET DST=$$BLDDSP(.DS,DD)
QUIT
+3 SET %=$SELECT($GET(DILONGX):DICR(DILONGX,"ORG"),$GET(DINDEX("IXTYPE"))'="S":$PIECE(X,U),1:"")
+4 SET %=%_$PIECE(DS(DD),U,2,9)_$SELECT($GET(DIYX(DD)):DIY(DD),1:"")
+5 IF ($GET(DITRANX)!($GET(DICRS)))
IF $GET(DINDEX(1,"TRANOUT"))]""
IF %]""
Begin DoDot:2
+6 NEW X
SET X=%
XECUTE DINDEX(1,"TRANOUT")
SET DST=$GET(X)
QUIT
End DoDot:2
QUIT
+7 IF +$PIECE(%,"E")=%
IF $DATA(DIDA)
DO DT
QUIT
+8 IF $GET(DICRS)
IF $GET(DINDEX("IXTYPE"))="R"
Begin DoDot:2
+9 NEW F1,F2
SET F1=$GET(DINDEX(1,"FILE"))
SET F2=$GET(DINDEX(1,"FIELD"))
+10 IF F1
IF F2
SET %=$$EXT^DIC2(F1,F2,%,"h")
+11 QUIT
End DoDot:2
+12 SET DST=%
QUIT
End DoDot:1
+13 IF DIC(0)["s"
SET DIC(0)=$TRANSLATE(DIC(0),"s")
+14 IF $DATA(DS(DD,"K"))
SET %=$GET(DIX)
MERGE DIX=DS(DD)
SET DIX=%
+15 SET DIY=$SELECT($GET(DIYX(DD)):"",1:DIY(DD))
DO WO^DIC2
QUIT
+16 ;
BLDDSP(DS,DD,DINDXFL,DIYX,DIY,DICRS) ; Build display of index values
+1 NEW X,I
SET X=""
+2 FOR I=0:0
SET I=$ORDER(DS(DD,I))
if 'I
QUIT
Begin DoDot:1
+3 IF $LENGTH(X)+$LENGTH(DS(DD,I))>240
QUIT
+4 IF I=1
IF $GET(DINDXFL)
SET X=$PIECE(DS(1),U,2,99)_$SELECT($GET(DIYX(1)):$GET(DIY(1)),1:"")
QUIT
+5 IF I=1
IF $GET(DICRS)
QUIT
+6 SET X=X_$PIECE(" ^",U,I>1)_DS(DD,I)
QUIT
End DoDot:1
+7 QUIT X
+8 ;
GOT ; Set data for single entry selected by user.
+1 NEW I,J,K
+2 IF DIY(DIY)=""
SET DIY(DIY)=$PIECE($GET(@(DIC_"Y,0)")),U)
+3 if $DATA(DDS)
SET DST=X_$PIECE(DS(DIY),U,2,9)_$SELECT($GET(DIYX(DIY)):$GET(DIY(DIY)),1:"")
+4 SET K=$ORDER(DIVPSEL("A"),-1)
IF K]""
SET DIVPSEL(K)=Y
+5 IF $GET(DIFINDR)
Begin DoDot:1
+6 if $DATA(DDS)
SET DS(0,"DST")=DST
+7 SET DS(0,"Y")=+DS(DIY)
SET DS(0,"X")=X_$PIECE(DS(DIY),"^",2)
SET DS(0,"DIYX")=$GET(DIYX(DIY))
SET DS(0,"DIY")=DIY(DIY)
+8 MERGE DS(0,1)=DS(DIY)
+9 QUIT
End DoDot:1
QUIT
+10 IF $GET(DIYX(DIY))
KILL DIYX
SET DIY(DIY)=$PIECE($GET(@(DIC_"Y,0)")),U)
+11 DO C^DIC2
QUIT
+12 ;
OK ;
+1 SET %=1
IF $GET(DS)=1
SET DST=" ...OK"
DO Y^DICN
if '$DATA(DDS)
WRITE !
+2 ;%=1=Yes, %=2=No
IF %>0
if %=1
QUIT
Begin DoDot:1
+3 ;Preserve IEN for future reference
IF $GET(DICR)
SET DICR(DICR,31.2)=+Y
+4 ;ReInit Display array
IF +$GET(DS)
KILL DS
SET (DS,DS(0),DS("DD"))=0
+5 QUIT
End DoDot:1
SET X=$GET(DIX)
SET Y=-1
QUIT
+6 ;User asked for Help
IF %=0
WRITE !?4,$$EZBLD^DIALOG(8040),!
GOTO OK
+7 ;User TIMED Out; DTOUT set in DICN
IF %=-1
IF $DATA(DTOUT)
SET DIROUT=1
+8 ;User single up-arrowed out
IF %=-1
IF '$DATA(DTOUT)
SET (DUOUT,DIROUT)=1
BAD SET Y=-1
+1 IF $GET(%Y)?1"^^".E
SET (DIROUT,DUOUT)=1
+2 SET DS(0)=$SELECT($GET(DTOUT):"1^T",$GET(DUOUT):"1^U",$GET(%)=-1:"1^U",1:"1^")
QUIT
MIX ;
+1 NEW DID
SET DID=D_"^-1"
SET DID(1)=2
+2 NEW D
SET D=$PIECE(DID,U)
+3 GOTO IX^DIC
+4 ;
+5 ;#8042 Select |filename|:
+6 ;#8040 Answer with 'Yes' or 'No'
