DICQ1 ;SFISC/GFT,TKW-HELP FOR LOOKUPS ;7/18/00 08:14 [ 04/02/2003 8:25 AM ]
;;22.0;VA FileMan;**1001**;APR 1, 2003
;;22.0;VA FileMan;**4,3,54**;Mar 30, 1999
;Per VHA Directive 10-93-142, this routine should not be modified.
EN ; Set up parameters for lister call, then display current entries.
I 'DIRECUR,'$D(DDS) D Z^DDSU
I DICNT>1,$D(DZ)#2 S DST=" " D:DZ["??"&'$D(DDS) %^DICQ S DST=$$EZBLD^DIALOG(8068) D %^DICQ
N DISCR S:$G(DIC("S"))]"" DISCR("S")=DIC("S")
I $D(DIC("V")) M DISCR("V")=DIC("V")
S %=$G(DIC("?PARAM",DIFILEI,"INDEX")) I %]"" D
. S (DIX,DIBEGIX)=%,DIX("WAY")=1 D INDEX^DICUIX(.DIFILEI,"hl",.DIX) Q
I $O(DIC("?PARAM",DIFILEI,"PART",0)) S DIPART(1)="",%=0 D
. F S %=$O(DIC("?PARAM",DIFILEI,"PART",%)) Q:'% I '(%#1) S DIPART(%)=DIC("?PARAM",DIFILEI,"PART",%)
. S DIPART=DIPART(1) Q
N DIFLAGS,DIFIELDS,DIIENS S DIFLAGS="MPh"
I 'DIUPRITE,"PV"[$G(DIX(1,"TYPE")) D
. N DIFRPRT S DIFRPRT=DIFROM_$G(DIC("?PARAM",DIFILEI,"FROM",1))_$G(DIPART)
. Q:'$$CHKP^DICUIX1(.DIFILEI,.DIX,DDC,DIFRPRT,.DISCR,1)
. S DIFLAGS="MPQh" K DIFROM S DIFROM="" Q
I DIUPRITE S DID01=0,DIBEGIX="#"
S DIIENS=$S(DIC(0)["p":",",1:DIENS)
S DIFIELDS="@;IX" D
. I 'DIUPRITE,DID01!(DIC(0)["S") K DID01 Q
. S DIC("DID01")="W "" "",$$EXT^DIC2("_DIFILEI_",.01,$P("_DIC_"Y,0),U))"
. Q
E1 K DDD S DD="",DIY=99,DDD=$S($D(DDS):1,1:5),(DIZ,DILN)=21
I $D(DDH)>10 D LIST^DDSU Q:$D(DDSQ)
I DIFROM]"" D S DIFROM(1)=DIFROM
. I +$P(DIFROM,"E")=DIFROM S DIFROM=DIFROM-.00000001 Q
. N M F %=$L(DIFROM):-1:1 S M=$A(DIFROM,%) I M>32 S DIFROM=$E(DIFROM,1,%-1)_$C(M-1)_$C(122) Q
. Q
I DIFLAGS'["Q" S %=$G(DIC("?PARAM",DIFILEI,"FROM",1)) I %]"" D
. S:DIFROM="" (DIFROM,DIFROM(1))=% S %=1
. F S %=$O(DIC("?PARAM",DIFILEI,"FROM",%)) Q:'% I '(%#1) S DIFROM(%)=DIC("?PARAM",DIFILEI,"FROM",%)
. Q
;
L ; List current entries in the file.
N DICQ
D LIST^DICL(.DIFILEI,DIIENS,DIFIELDS,DIFLAGS,DDC,.DIFROM,.DIPART,DIBEGIX,.DISCR,"","DICQ","",.DIC)
K DIC("DID01"),DICQ
D BK^DIEQ S:'$D(DDS) DDD=3 D LIST^DDSU K DDH Q:$D(DDSQ)!($G(DTOUT))
D 0 Q
;
DSP(DINDEX,DICQ,DIC,DIFILE) ; Display entries from DICQ array
; note: this routine is called from the lister, DICLIX & DICL1.
N I,J,F,X,Y,DD,DDD,DIY,DILN,DIZ,DIMAP,DDH,DID01,DIQUIET,DIPGM,DST,DISPACE,DIERR,DP
S DIMAP=$G(DICQ(0,"MAP")),DDH=0,DST="",DIPGM="DICQ1",$P(DISPACE," ",10)=""
S:$G(DIC("DID01"))]"" DID01=DIC("DID01")
N DIKEYL,DIKEY I $O(DIFILE(DIFILE,"KEY",DIFILE,0)),DIC(0)'["S" M DIKEYL=DIFILE(DIFILE,"KEY",DIFILE)
I $D(DIC("W"))!($D(DID01))!($D(DIKEYL)) D ID
F I=0:0 S I=$O(DICQ(I)) Q:'I S X=$G(DICQ(I,0)) I X]"" D
. S DST=""
. I DINDEX="#" S DST=$P(X,U)_" " S:$L(DST)<7 DST=DST_$E(DISPACE,($L(DST)+1),7)
. I $D(DIKEYL) S DIKEY(+X)="" F J=0:0 S J=$O(DIKEYL(J)) Q:'J!$G(DIERR) F F=0:0 S F=$O(DIKEYL(J,F)) Q:'F!$G(DIERR) D
. . I (F=.01&($D(DID01))!(DINDEX("FLISTD")[("^"_F_"^"))) D Q
. . . S:DIKEY(+X)="" DIKEY(+X)=" " Q
. . S Y=$$GET1^DIQ(DIFILE,+X_DIFILE(DIFILE,"KEY","IEN"),F,"","","DIERR") Q:$G(DIERR)
. . I ($L(DIKEY(+X)))+($L(Y))+2>240 S DIERR=1 Q
. . S DIKEY(+X)=DIKEY(+X)_$P(" ^",U,DIKEY(+X)]"")_Y Q
. F J=2:1 Q:$P(DIMAP,U,J)="" S Y=$P(X,U,J) D:$P(DIMAP,U,J+1)]"" S:$L(DST_Y)<240 DST=DST_Y
. . S Y=Y_" "
. . I J=(DINDEX("#")+1) S Y=Y_" "
. . Q
. I DST]"" S Y=+X,DDH=DDH+1,DDH(DDH,Y)=DST_" "
. Q
S DD="",DIY=99,DDD=5,DP=DIFILE
I '$G(DIC("?N",DIFILE)) S (DIZ,DILN)=21
E S (DIZ,DILN)=999
D LIST^DDSU K DICQ
K DIERR,^TMP("DIERR",$J)
Q
;
ID ; Put code to display .01 field and Identifiers into DDH array.
S DIY="I $D("_DIC_"Y,0))" I $D(DID01) S DIY=DIY_" "_DID01_" "_DIY
I $D(DIKEYL) S:$D(DID01) DIY=DIY_" W "" """ S DIY=DIY_" W DIKEY(Y)"
I '$D(DIC("W")) S DDH("ID")=DIY Q
S DIY=DIY_" "
I $L(DIC("W"))+$L(DIY)<240 S DDH("ID")=DIY_DIC("W") Q
S DDH("ID")=DIY_"X DDH(""ID"",1)" S DDH("ID",1)=DIC("W") Q
;
WOV N DIC,Y,DI1X,DIY,DIYX,%,C,DINAME S DIC=DIGBL,Y=DIEN,DI1X=0
W1 F S DI1X=$O(^DD(DIFILEI,0,"ID",DI1X)) Q:DI1X="" S %=^(DI1X) D
. X "W "" "",$E("_DIGBL_DIEN_",0),0)",%
Q
;
0 ; If LAYGO allowed, display additional help.
K DDC,DIEQ,DIW,DS I DIC(0)'["L" D QQ Q
I $D(%Y)#2 S:%Y="??" DZ=%Y S:%Y?1P DZ="?"
S DDH=+$G(DDH) N A1,DIACCESS S DIACCESS=1
I $S($D(DLAYGO):DIFILEI-DLAYGO\1,1:1),DUZ(0)'="@",'$D(^DD(DIFILEI,0,"UP")) D CHKACC
I '$G(DIACCESS) D RCR Q
10 ; Tell user that they may enter new entries to the file
I DZ?1."?" S DST=" " D DS^DIEQ S DST=$$EZBLD^DIALOG(8069,$P(DO,U)) D DS^DIEQ D:DZ="?" HP
D H
I DO(2)["S" S DST=$$EZBLD^DIALOG(8068)_" " D %^DICQ D
. N X,Y,A2,DST,DISETOC,DIMAXL S DIMAXL=0,DISETOC=$P(^DD(+DO(2),.01,0),U,3)
. F X=1:1 S Y=$P($P(DISETOC,";",X),":") Q:Y="" S:$L(Y)>DIMAXL DIMAXL=$L(Y)
. S DIMAXL=DIMAXL+4
. F X=1:1 S Y=$P(DISETOC,";",X) Q:Y="" S A2="",$P(A2," ",DIMAXL-$L($P(Y,":")))=" ",DST=" "_$P(Y,":")_A2_$P(Y,":",2) D DS^DIEQ
. Q
I DO(2)["V" D
. N DG,DU,D
. S DU=+DO(2),D=.01 D V^DIEQ Q
;
RCR ; Recursive call to display entries on pointed-to file.
I DO(2)'["P"!($G(DZ(1))=0) D QQ Q
N %,D,DS,DIPTRIX S D=""
S DS=^DD(+DO(2),.01,0)
S DIPTRIX=$G(DIC("PTRIX",+DO(2),.01,+$P($P(DS,U,2),"P",2)))
M %=DIC("PTRIX"),%(1)=DIC("?N"),%(2)=DIC("?PARAM")
N DIC M DIC("PTRIX")=%,DIC("?N")=%(1),DIC("?PARAM")=%(2) K %
S DIC=U_$P(DS,U,3),DIC(0)=$E("L",$P(DS,U,2)'["'")
I $P(DS,U,2)["*" D
. N DILCV,DICP,DIPTRIX,DISAV0 S DISAV0=DIC(0)
. F DILCV=" D ^DIC"," D IX^DIC"," D MIX^DIC1" S DICP=$F(DS,DILCV) I DICP D S DIC(0)=DISAV0
. . X $P($E(DS,1,DICP-$L(DILCV)-1),U,5,99) Q
. S D=$P($G(D),U) Q
S:DIPTRIX]"" D=$P(DIPTRIX,U) K DIPTRIX,DS
N DO,DIFILEI,DINDEX I D="" S D="B"
S DIRECUR=DIRECUR+1
D DQ^DICQ
QQ Q:$D(DDH)'>10
K DDD S DD="",DIY=99,DDD=$S($D(DDS):1,1:5),(DIZ,DILN)=21
S:$D(DDS) DDC=-1 D LIST^DDSU K DDC Q
;
HP N DG,X,%,DST
F DG=3,12 I $D(^DD(+DO(2),.01,DG)) S X=^(DG) F %=$L(X," "):-1:1 I $L($P(X," ",1,%))<70 S DST=$P(X," ",1,%) D DS^DIEQ,P1 Q
Q
;
P1 I %'=$L(X," ") S DST=$P(X," ",%+1,99) D DS^DIEQ
Q
;
H ; Display eXecutable help and long description for .01 field.
N %,X,DIPGM S %=DIC,X=DZ,DIPGM="DICQ1" D
. N DIC,D,DP,DIFILEI,DINDEX,DZ S DZ=X
. S DIC=%,D=.01,DP=+DO(2) D H^DIEQ Q
Q
;
CHKACC ;Check file access
N A1,DIFILE,DIAC,% S DIFILE=+DO(2),DIAC="LAYGO",%=0 D ^DIAC
S:% DIACCESS=1 Q
;
;#8069 You may enter a new |filename|, if you wish
;#8068 Choose from
DICQ1 ;SFISC/GFT,TKW-HELP FOR LOOKUPS ;7/18/00 08:14 [ 04/02/2003 8:25 AM ]
+1 ;;22.0;VA FileMan;**1001**;APR 1, 2003
+2 ;;22.0;VA FileMan;**4,3,54**;Mar 30, 1999
+3 ;Per VHA Directive 10-93-142, this routine should not be modified.
EN ; Set up parameters for lister call, then display current entries.
+1 IF 'DIRECUR
IF '$DATA(DDS)
DO Z^DDSU
+2 IF DICNT>1
IF $DATA(DZ)#2
SET DST=" "
IF DZ["??"&'$DATA(DDS)
DO %^DICQ
SET DST=$$EZBLD^DIALOG(8068)
DO %^DICQ
+3 NEW DISCR
IF $GET(DIC("S"))]""
SET DISCR("S")=DIC("S")
+4 IF $DATA(DIC("V"))
MERGE DISCR("V")=DIC("V")
+5 SET %=$GET(DIC("?PARAM",DIFILEI,"INDEX"))
IF %]""
Begin DoDot:1
+6 SET (DIX,DIBEGIX)=%
SET DIX("WAY")=1
DO INDEX^DICUIX(.DIFILEI,"hl",.DIX)
QUIT
End DoDot:1
+7 IF $ORDER(DIC("?PARAM",DIFILEI,"PART",0))
SET DIPART(1)=""
SET %=0
Begin DoDot:1
+8 FOR
SET %=$ORDER(DIC("?PARAM",DIFILEI,"PART",%))
IF '%
QUIT
IF '(%#1)
SET DIPART(%)=DIC("?PARAM",DIFILEI,"PART",%)
+9 SET DIPART=DIPART(1)
QUIT
End DoDot:1
+10 NEW DIFLAGS,DIFIELDS,DIIENS
SET DIFLAGS="MPh"
+11 IF 'DIUPRITE
IF "PV"[$GET(DIX(1,"TYPE"))
Begin DoDot:1
+12 NEW DIFRPRT
SET DIFRPRT=DIFROM_$GET(DIC("?PARAM",DIFILEI,"FROM",1))_$GET(DIPART)
+13 IF '$$CHKP^DICUIX1(.DIFILEI,.DIX,DDC,DIFRPRT,.DISCR,1)
QUIT
+14 SET DIFLAGS="MPQh"
KILL DIFROM
SET DIFROM=""
QUIT
End DoDot:1
+15 IF DIUPRITE
SET DID01=0
SET DIBEGIX="#"
+16 SET DIIENS=$SELECT(DIC(0)["p":",",1:DIENS)
+17 SET DIFIELDS="@;IX"
Begin DoDot:1
+18 IF 'DIUPRITE
IF DID01!(DIC(0)["S")
KILL DID01
QUIT
+19 SET DIC("DID01")="W "" "",$$EXT^DIC2("_DIFILEI_",.01,$P("_DIC_"Y,0),U))"
+20 QUIT
End DoDot:1
E1 KILL DDD
SET DD=""
SET DIY=99
SET DDD=$SELECT($DATA(DDS):1,1:5)
SET (DIZ,DILN)=21
+1 IF $DATA(DDH)>10
DO LIST^DDSU
IF $DATA(DDSQ)
QUIT
+2 IF DIFROM]""
Begin DoDot:1
+3 IF +$PIECE(DIFROM,"E")=DIFROM
SET DIFROM=DIFROM-.00000001
QUIT
+4 NEW M
FOR %=$LENGTH(DIFROM):-1:1
SET M=$ASCII(DIFROM,%)
IF M>32
SET DIFROM=$EXTRACT(DIFROM,1,%-1)_$CHAR(M-1)_$CHAR(122)
QUIT
+5 QUIT
End DoDot:1
SET DIFROM(1)=DIFROM
+6 IF DIFLAGS'["Q"
SET %=$GET(DIC("?PARAM",DIFILEI,"FROM",1))
IF %]""
Begin DoDot:1
+7 IF DIFROM=""
SET (DIFROM,DIFROM(1))=%
SET %=1
+8 FOR
SET %=$ORDER(DIC("?PARAM",DIFILEI,"FROM",%))
IF '%
QUIT
IF '(%#1)
SET DIFROM(%)=DIC("?PARAM",DIFILEI,"FROM",%)
+9 QUIT
End DoDot:1
+10 ;
L ; List current entries in the file.
+1 NEW DICQ
+2 DO LIST^DICL(.DIFILEI,DIIENS,DIFIELDS,DIFLAGS,DDC,.DIFROM,.DIPART,DIBEGIX,.DISCR,"","DICQ","",.DIC)
+3 KILL DIC("DID01"),DICQ
+4 DO BK^DIEQ
IF '$DATA(DDS)
SET DDD=3
DO LIST^DDSU
KILL DDH
IF $DATA(DDSQ)!($GET(DTOUT))
QUIT
+5 DO 0
QUIT
+6 ;
DSP(DINDEX,DICQ,DIC,DIFILE) ; Display entries from DICQ array
+1 ; note: this routine is called from the lister, DICLIX & DICL1.
+2 NEW I,J,F,X,Y,DD,DDD,DIY,DILN,DIZ,DIMAP,DDH,DID01,DIQUIET,DIPGM,DST,DISPACE,DIERR,DP
+3 SET DIMAP=$GET(DICQ(0,"MAP"))
SET DDH=0
SET DST=""
SET DIPGM="DICQ1"
SET $PIECE(DISPACE," ",10)=""
+4 IF $GET(DIC("DID01"))]""
SET DID01=DIC("DID01")
+5 NEW DIKEYL,DIKEY
IF $ORDER(DIFILE(DIFILE,"KEY",DIFILE,0))
IF DIC(0)'["S"
MERGE DIKEYL=DIFILE(DIFILE,"KEY",DIFILE)
+6 IF $DATA(DIC("W"))!($DATA(DID01))!($DATA(DIKEYL))
DO ID
+7 FOR I=0:0
SET I=$ORDER(DICQ(I))
IF 'I
QUIT
SET X=$GET(DICQ(I,0))
IF X]""
Begin DoDot:1
+8 SET DST=""
+9 IF DINDEX="#"
SET DST=$PIECE(X,U)_" "
IF $LENGTH(DST)<7
SET DST=DST_$EXTRACT(DISPACE,($LENGTH(DST)+1),7)
+10 IF $DATA(DIKEYL)
SET DIKEY(+X)=""
FOR J=0:0
SET J=$ORDER(DIKEYL(J))
IF 'J!$GET(DIERR)
QUIT
FOR F=0:0
SET F=$ORDER(DIKEYL(J,F))
IF 'F!$GET(DIERR)
QUIT
Begin DoDot:2
+11 IF (F=.01&($DATA(DID01))!(DINDEX("FLISTD")[("^"_F_"^")))
Begin DoDot:3
+12 IF DIKEY(+X)=""
SET DIKEY(+X)=" "
QUIT
End DoDot:3
QUIT
+13 SET Y=$$GET1^DIQ(DIFILE,+X_DIFILE(DIFILE,"KEY","IEN"),F,"","","DIERR")
IF $GET(DIERR)
QUIT
+14 IF ($LENGTH(DIKEY(+X)))+($LENGTH(Y))+2>240
SET DIERR=1
QUIT
+15 SET DIKEY(+X)=DIKEY(+X)_$PIECE(" ^",U,DIKEY(+X)]"")_Y
QUIT
End DoDot:2
+16 FOR J=2:1
IF $PIECE(DIMAP,U,J)=""
QUIT
SET Y=$PIECE(X,U,J)
IF $PIECE(DIMAP,U,J+1)]""
Begin DoDot:2
+17 SET Y=Y_" "
+18 IF J=(DINDEX("#")+1)
SET Y=Y_" "
+19 QUIT
End DoDot:2
IF $LENGTH(DST_Y)<240
SET DST=DST_Y
+20 IF DST]""
SET Y=+X
SET DDH=DDH+1
SET DDH(DDH,Y)=DST_" "
+21 QUIT
End DoDot:1
+22 SET DD=""
SET DIY=99
SET DDD=5
SET DP=DIFILE
+23 IF '$GET(DIC("?N",DIFILE))
SET (DIZ,DILN)=21
+24 IF '$TEST
SET (DIZ,DILN)=999
+25 DO LIST^DDSU
KILL DICQ
+26 KILL DIERR,^TMP("DIERR",$JOB)
+27 QUIT
+28 ;
ID ; Put code to display .01 field and Identifiers into DDH array.
+1 SET DIY="I $D("_DIC_"Y,0))"
IF $DATA(DID01)
SET DIY=DIY_" "_DID01_" "_DIY
+2 IF $DATA(DIKEYL)
IF $DATA(DID01)
SET DIY=DIY_" W "" """
SET DIY=DIY_" W DIKEY(Y)"
+3 IF '$DATA(DIC("W"))
SET DDH("ID")=DIY
QUIT
+4 SET DIY=DIY_" "
+5 IF $LENGTH(DIC("W"))+$LENGTH(DIY)<240
SET DDH("ID")=DIY_DIC("W")
QUIT
+6 SET DDH("ID")=DIY_"X DDH(""ID"",1)"
SET DDH("ID",1)=DIC("W")
QUIT
+7 ;
WOV NEW DIC,Y,DI1X,DIY,DIYX,%,C,DINAME
SET DIC=DIGBL
SET Y=DIEN
SET DI1X=0
W1 FOR
SET DI1X=$ORDER(^DD(DIFILEI,0,"ID",DI1X))
IF DI1X=""
QUIT
SET %=^(DI1X)
Begin DoDot:1
+1 XECUTE "W "" "",$E("_DIGBL_DIEN_",0),0)"
XECUTE %
End DoDot:1
+2 QUIT
+3 ;
0 ; If LAYGO allowed, display additional help.
+1 KILL DDC,DIEQ,DIW,DS
IF DIC(0)'["L"
DO QQ
QUIT
+2 IF $DATA(%Y)#2
IF %Y="??"
SET DZ=%Y
IF %Y?1P
SET DZ="?"
+3 SET DDH=+$GET(DDH)
NEW A1,DIACCESS
SET DIACCESS=1
+4 IF $SELECT($DATA(DLAYGO):DIFILEI-DLAYGO\1,1:1)
IF DUZ(0)'="@"
IF '$DATA(^DD(DIFILEI,0,"UP"))
DO CHKACC
+5 IF '$GET(DIACCESS)
DO RCR
QUIT
10 ; Tell user that they may enter new entries to the file
+1 IF DZ?1."?"
SET DST=" "
DO DS^DIEQ
SET DST=$$EZBLD^DIALOG(8069,$PIECE(DO,U))
DO DS^DIEQ
IF DZ="?"
DO HP
+2 DO H
+3 IF DO(2)["S"
SET DST=$$EZBLD^DIALOG(8068)_" "
DO %^DICQ
Begin DoDot:1
+4 NEW X,Y,A2,DST,DISETOC,DIMAXL
SET DIMAXL=0
SET DISETOC=$PIECE(^DD(+DO(2),.01,0),U,3)
+5 FOR X=1:1
SET Y=$PIECE($PIECE(DISETOC,";",X),":")
IF Y=""
QUIT
IF $LENGTH(Y)>DIMAXL
SET DIMAXL=$LENGTH(Y)
+6 SET DIMAXL=DIMAXL+4
+7 FOR X=1:1
SET Y=$PIECE(DISETOC,";",X)
IF Y=""
QUIT
SET A2=""
SET $PIECE(A2," ",DIMAXL-$LENGTH($PIECE(Y,":")))=" "
SET DST=" "_$PIECE(Y,":")_A2_$PIECE(Y,":",2)
DO DS^DIEQ
+8 QUIT
End DoDot:1
+9 IF DO(2)["V"
Begin DoDot:1
+10 NEW DG,DU,D
+11 SET DU=+DO(2)
SET D=.01
DO V^DIEQ
QUIT
End DoDot:1
+12 ;
RCR ; Recursive call to display entries on pointed-to file.
+1 IF DO(2)'["P"!($GET(DZ(1))=0)
DO QQ
QUIT
+2 NEW %,D,DS,DIPTRIX
SET D=""
+3 SET DS=^DD(+DO(2),.01,0)
+4 SET DIPTRIX=$GET(DIC("PTRIX",+DO(2),.01,+$PIECE($PIECE(DS,U,2),"P",2)))
+5 MERGE %=DIC("PTRIX"),%(1)=DIC("?N"),%(2)=DIC("?PARAM")
+6 NEW DIC
MERGE DIC("PTRIX")=%,DIC("?N")=%(1),DIC("?PARAM")=%(2)
KILL %
+7 SET DIC=U_$PIECE(DS,U,3)
SET DIC(0)=$EXTRACT("L",$PIECE(DS,U,2)'["'")
+8 IF $PIECE(DS,U,2)["*"
Begin DoDot:1
+9 NEW DILCV,DICP,DIPTRIX,DISAV0
SET DISAV0=DIC(0)
+10 FOR DILCV=" D ^DIC"," D IX^DIC"," D MIX^DIC1"
SET DICP=$FIND(DS,DILCV)
IF DICP
Begin DoDot:2
+11 XECUTE $PIECE($EXTRACT(DS,1,DICP-$LENGTH(DILCV)-1),U,5,99)
QUIT
End DoDot:2
SET DIC(0)=DISAV0
+12 SET D=$PIECE($GET(D),U)
QUIT
End DoDot:1
+13 IF DIPTRIX]""
SET D=$PIECE(DIPTRIX,U)
KILL DIPTRIX,DS
+14 NEW DO,DIFILEI,DINDEX
IF D=""
SET D="B"
+15 SET DIRECUR=DIRECUR+1
+16 DO DQ^DICQ
QQ IF $DATA(DDH)'>10
QUIT
+1 KILL DDD
SET DD=""
SET DIY=99
SET DDD=$SELECT($DATA(DDS):1,1:5)
SET (DIZ,DILN)=21
+2 IF $DATA(DDS)
SET DDC=-1
DO LIST^DDSU
KILL DDC
QUIT
+3 ;
HP NEW DG,X,%,DST
+1 FOR DG=3,12
IF $DATA(^DD(+DO(2),.01,DG))
SET X=^(DG)
FOR %=$LENGTH(X," "):-1:1
IF $LENGTH($PIECE(X," ",1,%))<70
SET DST=$PIECE(X," ",1,%)
DO DS^DIEQ
DO P1
QUIT
+2 QUIT
+3 ;
P1 IF %'=$LENGTH(X," ")
SET DST=$PIECE(X," ",%+1,99)
DO DS^DIEQ
+1 QUIT
+2 ;
H ; Display eXecutable help and long description for .01 field.
+1 NEW %,X,DIPGM
SET %=DIC
SET X=DZ
SET DIPGM="DICQ1"
Begin DoDot:1
+2 NEW DIC,D,DP,DIFILEI,DINDEX,DZ
SET DZ=X
+3 SET DIC=%
SET D=.01
SET DP=+DO(2)
DO H^DIEQ
QUIT
End DoDot:1
+4 QUIT
+5 ;
CHKACC ;Check file access
+1 NEW A1,DIFILE,DIAC,%
SET DIFILE=+DO(2)
SET DIAC="LAYGO"
SET %=0
DO ^DIAC
+2 IF %
SET DIACCESS=1
QUIT
+3 ;
+4 ;#8069 You may enter a new |filename|, if you wish
+5 ;#8068 Choose from
