- DIEQ ;SFISC/XAK,YJK-HELP DURING INPUT ;09:13 AM 27 Jul 2001 [ 04/02/2003 8:25 AM ]
- ;;22.0;VA FileMan;**1001**;APR 1, 2003
- ;;22.0;VA FileMan;**4,3,59**;Mar 30, 1999
- ;Per VHA Directive 10-93-142, this routine should not be modified.
- BN S D=$P(DQ(DQ),U,4) S:DP+1 D=DIFLD
- S DZ=X D EN1 G B^DIED
- QQ ;
- I DV,DV["*",$D(^DD(+DV,.01,0)) S DQ(DQ)=$P(DQ(DQ),U,1,4)_U_$P(^(0),U,5,99)
- EN1 S DDH=0 G M:DV I DP<0 D HP G P
- I X="?"!(X["BAD") F DG=3,12 Q:DG=12&($G(DISORT)) I $D(^DD(DP,D,DG)) S X=^(DG),A1="T" D N
- D H G:'$D(DZ) Q
- ;
- P I DV["P" K DO S DIC=U_DU,D="B",DIC(0)="M"_$E("L",DV'["'") G AST:DV["*"&('$G(DISORT)) D DQ^DICQ D %
- VP I DV["V" S DU=DP S:DV DU=+DO(2),D=.01 D V G Q
- D I DV["D" S %(0)=0,%DT=$P($P($P(DQ(DQ),U,5,9),"%DT=""",2),"""",1) D HELP^%DTC
- S I DV["S" X:($D(^DD(DP,D,12.1))#2)&('$G(DISORT)) ^(12.1) S A1="T",DST=$$EZBLD^DIALOG(8068)_" " D DS,S1 K DIC("S")
- Q K DST,A1 S:$D(DIE) DIC=DIE S D=0 I $D(DDH)>10 D LIST^DDSU
- D:DV UDA
- Q
- ;
- ;
- S1 F DG=1:1 S Y=$P($P(DQ(DQ),U,3),";",DG) Q:Y="" S D=$P(Y,":",2),Y=$P(Y,":",1) X:$D(DIC("S")) DIC("S") I S A2="",$P(A2," ",15-($L(Y)+7))=" ",DST=" "_Y_A2_" "_D D DS
- K A1,A2 Q
- ;
- N F Q:X="" F %=$L(X," "):-1:1 I $L($P(X," ",1,%))<75 S DST=$P(X," ",1,%) D DS D:X'="" N1 Q
- S X=DZ
- Q
- ;
- N1 S X=$P(X," ",%+1,$L(X," ")) Q
- ;
- DS S:'$D(A1) A1="T" S DDH=$G(DDH)+1,DDH(DDH,A1)=$S(A1="X":"",1:" ")_DST K A1,DST Q
- ;
- HP I $D(DQ(DQ,3)) S A1="T",DST=DQ(DQ,3) D DS
- I $D(DQ(DQ,4)) S A1="X",DST=DQ(DQ,4) D DS
- Q
- ;
- % S %=$G(DIC("V")) K DIC S:%]"" DIC("V")=% Q
- ;
- AST S:$D(X)[0 X="?" X $P(DQ(DQ),U,5,99) K DIC G Q
- D ^DIC K DIC,DICS,DICW G Q
- ;
- M K DO S DZ=X,DIC=DIE_DA_","_$S(+$P(DC,U,3)=$P(DC,U,3):$P(DC,U,3),1:$C(34)_$P(DC,U,3)_$C(34))_",",D="B",DIC(0)="LM",DZ(1)=0
- I '$D(@(DIC_"0)")) S DO=U_$P(DC,U,2) D DO2^DIC1
- D:'$D(DO) DO^DIC1
- D DDA,DQ^DICQ D % G Q:'$D(DZ)!(DV["S") S X=DZ G P
- ;
- H I '$G(DISORT),$D(^DD(DP,D,4)) S A1="X",DST=^(4) D DS,LIST^DDSU Q:'$D(DZ)!$D(DDSQ)
- I $G(X)?1"??".E,X'["BAD" D
- . N DIDG,DG,DDD,DD,DIY,DIZ,DUOUT
- . S DIDG=$P($G(^DD(DP,D,21,0)),U,3)
- . K DDSQ
- . I '$D(DDS) S DDD=5,DD="",DIY=99,DIZ=21 I $G(DIPGM)'="DICQ1" N DIPGM S DIPGM="DIEQ" D Z^DDSU
- . F DG=1:1 Q:'$D(^DD(DP,D,21,DG,0)) Q:+DIDG&(DG>DIDG) D Q:$D(DDSQ)
- . . I '($G(DDH)#15) D LIST^DDSU I $G(DTOUT)!($G(DUOUT)) S DDSQ=1
- . . Q:$D(DDSQ)
- . . S DST=^DD(DP,D,21,DG,0) D DS Q
- . I '$D(DDSQ) Q:$D(DDH)'>10 D LIST^DDSU
- . I $D(DDSQ) K DDSQ,DDH
- . Q
- Q
- ;
- BK S DDH=$G(DDH)+1,DDH(DDH,"T")=" " Q
- ;
- V S DDH=+$G(DDH),A1="T",DST=$$EZBLD^DIALOG(8071) D DS
- F Y=0:0 S Y=$O(^DD(DU,D,"V",Y)) Q:Y'>0 I $D(^(Y,0)) S Y(0)=^(0) X:$D(DIC("V")) DIC("V") I I $D(^DIC(+Y(0),0)) S Y(1)=$P(Y(0),U,4),Y(2)=$P(Y(0),U,2),DST=$$EZBLD^DIALOG(8072,.Y) K Y(1),Y(2) D DS
- D BK S DST=$$EZBLD^DIALOG(8073) D DS S DU="" D BK I DZ'?1"??".E K X,DZ Q
- D T^DIEQ1 K X,DZ Q
- ;
- DDA N T,%
- S T=$T
- F %=+$O(DA(" "),-1):-1:1 K DA(%+1) S:$D(DA(%))#2 DA(%+1)=DA(%)
- K DA(1) S:$D(DA)#2 DA(1)=DA
- I T
- Q
- ;
- UDA N T,%
- S T=$T
- S DA=$G(DA(1)) ;K DA(1)
- F %=2:1:+$O(DA(" "),-1) I $D(DA(%))#2 S DA(%-1)=DA(%) K DA(%)
- I T
- Q
- ;
- ;#8071 Enter one of the following
- ;#8072 |Prefix|.EntryName to select a |filename|
- ;#8073 To see the entries in any particular file type <Prefix.?>
- DIEQ ;SFISC/XAK,YJK-HELP DURING INPUT ;09:13 AM 27 Jul 2001 [ 04/02/2003 8:25 AM ]
- +1 ;;22.0;VA FileMan;**1001**;APR 1, 2003
- +2 ;;22.0;VA FileMan;**4,3,59**;Mar 30, 1999
- +3 ;Per VHA Directive 10-93-142, this routine should not be modified.
- BN SET D=$PIECE(DQ(DQ),U,4)
- IF DP+1
- SET D=DIFLD
- +1 SET DZ=X
- DO EN1
- GOTO B^DIED
- QQ ;
- +1 IF DV
- IF DV["*"
- IF $DATA(^DD(+DV,.01,0))
- SET DQ(DQ)=$PIECE(DQ(DQ),U,1,4)_U_$PIECE(^(0),U,5,99)
- EN1 SET DDH=0
- IF DV
- GOTO M
- IF DP<0
- DO HP
- GOTO P
- +1 IF X="?"!(X["BAD")
- FOR DG=3,12
- IF DG=12&($GET(DISORT))
- QUIT
- IF $DATA(^DD(DP,D,DG))
- SET X=^(DG)
- SET A1="T"
- DO N
- +2 DO H
- IF '$DATA(DZ)
- GOTO Q
- +3 ;
- P IF DV["P"
- KILL DO
- SET DIC=U_DU
- SET D="B"
- SET DIC(0)="M"_$EXTRACT("L",DV'["'")
- IF DV["*"&('$GET(DISORT))
- GOTO AST
- DO DQ^DICQ
- DO %
- VP IF DV["V"
- SET DU=DP
- IF DV
- SET DU=+DO(2)
- SET D=.01
- DO V
- GOTO Q
- D IF DV["D"
- SET %(0)=0
- SET %DT=$PIECE($PIECE($PIECE(DQ(DQ),U,5,9),"%DT=""",2),"""",1)
- DO HELP^%DTC
- S IF DV["S"
- IF ($DATA(^DD(DP,D,12.1))#2)&('$GET(DISORT))
- XECUTE ^(12.1)
- SET A1="T"
- SET DST=$$EZBLD^DIALOG(8068)_" "
- DO DS
- DO S1
- KILL DIC("S")
- Q KILL DST,A1
- IF $DATA(DIE)
- SET DIC=DIE
- SET D=0
- IF $DATA(DDH)>10
- DO LIST^DDSU
- +1 IF DV
- DO UDA
- +2 QUIT
- +3 ;
- +4 ;
- S1 FOR DG=1:1
- SET Y=$PIECE($PIECE(DQ(DQ),U,3),";",DG)
- IF Y=""
- QUIT
- SET D=$PIECE(Y,":",2)
- SET Y=$PIECE(Y,":",1)
- IF $DATA(DIC("S"))
- XECUTE DIC("S")
- IF $TEST
- SET A2=""
- SET $PIECE(A2," ",15-($LENGTH(Y)+7))=" "
- SET DST=" "_Y_A2_" "_D
- DO DS
- +1 KILL A1,A2
- QUIT
- +2 ;
- N FOR
- IF X=""
- QUIT
- FOR %=$LENGTH(X," "):-1:1
- IF $LENGTH($PIECE(X," ",1,%))<75
- SET DST=$PIECE(X," ",1,%)
- DO DS
- IF X'=""
- DO N1
- QUIT
- +1 SET X=DZ
- +2 QUIT
- +3 ;
- N1 SET X=$PIECE(X," ",%+1,$LENGTH(X," "))
- QUIT
- +1 ;
- DS IF '$DATA(A1)
- SET A1="T"
- SET DDH=$GET(DDH)+1
- SET DDH(DDH,A1)=$SELECT(A1="X":"",1:" ")_DST
- KILL A1,DST
- QUIT
- +1 ;
- HP IF $DATA(DQ(DQ,3))
- SET A1="T"
- SET DST=DQ(DQ,3)
- DO DS
- +1 IF $DATA(DQ(DQ,4))
- SET A1="X"
- SET DST=DQ(DQ,4)
- DO DS
- +2 QUIT
- +3 ;
- % SET %=$GET(DIC("V"))
- KILL DIC
- IF %]""
- SET DIC("V")=%
- QUIT
- +1 ;
- AST IF $DATA(X)[0
- SET X="?"
- XECUTE $PIECE(DQ(DQ),U,5,99)
- KILL DIC
- GOTO Q
- +1 DO ^DIC
- KILL DIC,DICS,DICW
- GOTO Q
- +2 ;
- M KILL DO
- SET DZ=X
- SET DIC=DIE_DA_","_$SELECT(+$PIECE(DC,U,3)=$PIECE(DC,U,3):$PIECE(DC,U,3),1:$CHAR(34)_$PIECE(DC,U,3)_$CHAR(34))_","
- SET D="B"
- SET DIC(0)="LM"
- SET DZ(1)=0
- +1 IF '$DATA(@(DIC_"0)"))
- SET DO=U_$PIECE(DC,U,2)
- DO DO2^DIC1
- +2 IF '$DATA(DO)
- DO DO^DIC1
- +3 DO DDA
- DO DQ^DICQ
- DO %
- IF '$DATA(DZ)!(DV["S")
- GOTO Q
- SET X=DZ
- GOTO P
- +4 ;
- H IF '$GET(DISORT)
- IF $DATA(^DD(DP,D,4))
- SET A1="X"
- SET DST=^(4)
- DO DS
- DO LIST^DDSU
- IF '$DATA(DZ)!$DATA(DDSQ)
- QUIT
- +1 IF $GET(X)?1"??".E
- IF X'["BAD"
- Begin DoDot:1
- +2 NEW DIDG,DG,DDD,DD,DIY,DIZ,DUOUT
- +3 SET DIDG=$PIECE($GET(^DD(DP,D,21,0)),U,3)
- +4 KILL DDSQ
- +5 IF '$DATA(DDS)
- SET DDD=5
- SET DD=""
- SET DIY=99
- SET DIZ=21
- IF $GET(DIPGM)'="DICQ1"
- NEW DIPGM
- SET DIPGM="DIEQ"
- DO Z^DDSU
- +6 FOR DG=1:1
- IF '$DATA(^DD(DP,D,21,DG,0))
- QUIT
- IF +DIDG&(DG>DIDG)
- QUIT
- Begin DoDot:2
- +7 IF '($GET(DDH)#15)
- DO LIST^DDSU
- IF $GET(DTOUT)!($GET(DUOUT))
- SET DDSQ=1
- +8 IF $DATA(DDSQ)
- QUIT
- +9 SET DST=^DD(DP,D,21,DG,0)
- DO DS
- QUIT
- End DoDot:2
- IF $DATA(DDSQ)
- QUIT
- +10 IF '$DATA(DDSQ)
- IF $DATA(DDH)'>10
- QUIT
- DO LIST^DDSU
- +11 IF $DATA(DDSQ)
- KILL DDSQ,DDH
- +12 QUIT
- End DoDot:1
- +13 QUIT
- +14 ;
- BK SET DDH=$GET(DDH)+1
- SET DDH(DDH,"T")=" "
- QUIT
- +1 ;
- V SET DDH=+$GET(DDH)
- SET A1="T"
- SET DST=$$EZBLD^DIALOG(8071)
- DO DS
- +1 FOR Y=0:0
- SET Y=$ORDER(^DD(DU,D,"V",Y))
- IF Y'>0
- QUIT
- IF $DATA(^(Y,0))
- SET Y(0)=^(0)
- IF $DATA(DIC("V"))
- XECUTE DIC("V")
- IF $TEST
- IF $DATA(^DIC(+Y(0),0))
- SET Y(1)=$PIECE(Y(0),U,4)
- SET Y(2)=$PIECE(Y(0),U,2)
- SET DST=$$EZBLD^DIALOG(8072,.Y)
- KILL Y(1),Y(2)
- DO DS
- +2 DO BK
- SET DST=$$EZBLD^DIALOG(8073)
- DO DS
- SET DU=""
- DO BK
- IF DZ'?1"??".E
- KILL X,DZ
- QUIT
- +3 DO T^DIEQ1
- KILL X,DZ
- QUIT
- +4 ;
- DDA NEW T,%
- +1 SET T=$TEST
- +2 FOR %=+$ORDER(DA(" "),-1):-1:1
- KILL DA(%+1)
- IF $DATA(DA(%))#2
- SET DA(%+1)=DA(%)
- +3 KILL DA(1)
- IF $DATA(DA)#2
- SET DA(1)=DA
- +4 IF T
- +5 QUIT
- +6 ;
- UDA NEW T,%
- +1 SET T=$TEST
- +2 ;K DA(1)
- SET DA=$GET(DA(1))
- +3 FOR %=2:1:+$ORDER(DA(" "),-1)
- IF $DATA(DA(%))#2
- SET DA(%-1)=DA(%)
- KILL DA(%)
- +4 IF T
- +5 QUIT
- +6 ;
- +7 ;#8071 Enter one of the following
- +8 ;#8072 |Prefix|.EntryName to select a |filename|
- +9 ;#8073 To see the entries in any particular file type <Prefix.?>
