- DIC1 ;SFISC/GFT/TKW-READ X, SHOW CHOICES ;29SEP2010
- ;;22.0;VA FileMan;**1,4,17,20,31,48,78,86,70,122,165**;Mar 30, 1999;Build 34
- ;Per VHA Directive 2004-038, this routine should not be modified.
- 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
- DO2 S DO(2)=$P(DO,U,2) I DO?1"^".E S DO=$O(^DD(+DO(2),0,"NM",0))_DO
- 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_$$FMTE^DILIBF(%,"7S")
- 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
- . 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 !,"Press <RETURN> to see more, '^' to exit this list,"_$S(DIC(0)["T":" '^^' to exit all lists,",1:"")_" OR" ;**122**
- . . W !,"CHOOSE "_$O(DS(0))_"-"_DD R ": ",DIY:$S($D(DTIME):DTIME,1:300) S:'$T DTOUT=1 Q
- . 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
- . Q:DIC(0)["U"
- . 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'
- DIC1 ;SFISC/GFT/TKW-READ X, SHOW CHOICES ;29SEP2010
- +1 ;;22.0;VA FileMan;**1,4,17,20,31,48,78,86,70,122,165**;Mar 30, 1999;Build 34
- +2 ;Per VHA Directive 2004-038, this routine should not be modified.
- +3 KILL DUOUT,DTOUT
- NEW DD,DIY,DISUB,DIPRMT
- +4 DO GETFA(.DIC,.DO)
- +5 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
- DO2 SET DO(2)=$PIECE(DO,U,2)
- IF DO?1"^".E
- SET DO=$ORDER(^DD(+DO(2),0,"NM",0))_DO
- +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 SET DST=DST_$$FMTE^DILIBF(%,"7S")
- +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 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 ;**122**
- IF DS>DD
- WRITE !,"Press <RETURN> to see more, '^' to exit this list,"_$SELECT(DIC(0)["T":" '^^' to exit all lists,",1:"")_" OR"
- +17 WRITE !,"CHOOSE "_$ORDER(DS(0))_"-"_DD
- 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 IF DIC(0)["U"
- QUIT
- +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'
