Return to DIR.m CVS log

Up to [Coherent Logic Development] / freem_fileman / USER

Annotation of freem_fileman/USER/DIR.m, revision 1.1

1.1     ! snw         1: DIR    ;SFISC/XAK-READER, HELP ;03:29 PM  22 Nov 1994
        !             2:        ;;21.0;VA FileMan;;Dec 28, 1994
        !             3:        ;Per VHA Directive 10-93-142, this routine should not be modified.
        !             4:        N %,%A,%B,%B1,%B2,%B3,%BA,%C,%E,%G,%H,%I,%J,%N,%P,%S,%T,%W,%X,%Y,A0,C,D,DD,DDH,DDQ,DDSV,DG,DH,DIC,DIFLD,DIRO,DO,DP,DQ,DU,DZ,X1,XQH,DIX,DIY,DISYS,%BU,%J1,%A0,%W0,%D1,%D2,%DT,%K,%M
        !             5:        S:$D(DDH)[0 DDH=0 Q:'$D(DIR(0))  D ^DIR2 G Q:%T=""
        !             6:        I $D(DIR("V"))#2 D ^DIR1 S DDER=%E G Q
        !             7: A      I $D(DDM) K:DDM DDQ S:'DDM DDQ=IOSL-7
        !             8:        I $G(DDH) D LIST^DDSU
        !             9:        D W:%A'["V" I $D(DDS),$D(DIR0) S DDACT=Y I DDO=.5 S DDM=1 G Q
        !            10:        I $D(DTOUT) K Y S DIRUT=1,Y="" G Q
        !            11:        I %T'="E",X?1."^".E K Y S (DUOUT,DIRUT)=1,Y=X S:X="^^" DIROUT=1 S:%T="Y" %=-1 G Q
        !            12:        I %T'="E","@"[X,%A["O" S Y="",DIRUT=1 S:%T="P" Y=-1 G Q
        !            13:        I %A'["O","@"[X,%T'="E" S A0=$C(7)_%A0 D MSG G A
        !            14:        I $D(DDS),$D(DIR0),DIR0N G Q
        !            15:        I $D(%G),$D(DIR("B")),X=DIR("B") S Y=%G G Q
        !            16:        I X'?1."?" K DDQ D ^DIR1 I '%E,$P(DIR(0),U,3)]"" S %X=X X $P(DIR(0),U,3,99) S:'$D(X) %E=1 S X=%X
        !            17:        I %A["V" K:%E Y G Q
        !            18:        I X?1."?"!%E D QUES:%E'<0 S A0="" D MSG D:$G(DDH) LIST^DDSU G A
        !            19:        G Q
        !            20:        ;
        !            21: W      ;
        !            22:        S %W=%W0,%N=$E(%W)=U
        !            23:        K DTOUT,DUOUT,DIRUT,DIROUT S %E=0 I $D(DDS),$D(DIR0) D ^DIR0 Q
        !            24:        I %T="S",%A'["A",%A'["B" D S
        !            25:        I $D(DIR("A"))=11 F %=0:0 S %=$O(DIR("A",%)) Q:%'>0  W !,DIR("A",%)
        !            26:        W ! W:$L(%P) %P
        !            27:        I $D(DIR("B")) W DIR("B") I $L(DIR("B"))<20!(%T="D")!(%T="S")!((%B["D"&%T)) W "// "
        !            28:        I %T'="D",$D(DIR("B")),$L(DIR("B"))>19,%T'="S",(%B'["D"&%T)!'%T S Y=DIR("B") D RW^DIR2 S:X="" X=DIR("B") Q
        !            29:        R X:$S($D(DIR("T")):DIR("T"),'$D(DTIME):300,1:DTIME) I '$T S DTOUT=1
        !            30:        I X="",$D(DIR("B")) S X=DIR("B") I %T'="D",%B'["D"&%T W X
        !            31:        I X'?.ANP S X="?"
        !            32:        Q
        !            33:        ;
        !            34: QU     I %E!(X="?")!($O(^DD(%B1,%B2,21,0))'>0) K %Y S A0="" D MSG F %C=3,12 I $D(^DD(%B1,%B2,%C)) S X1=^(%C),%J=75,%Y=1 D W1
        !            35:        I $D(^DD(%B1,%B2,4)) S A0=^(4),A0(0)=1 D MSG
        !            36:        I X?1"??".E D
        !            37:        . I $D(DDS) N DDC,DDSQ S DDC=7
        !            38:        . S A0="" D MSG S %C=0
        !            39:        . F  S %C=$O(^DD(%B1,%B2,21,%C)) Q:'%C!$D(DDSQ)  S A0=^(%C,0) D
        !            40:        .. I $D(DDS),$G(DDH),'(DDH#DDC) D LIST^DDSU Q:$D(DDSQ)
        !            41:        .. D MSG
        !            42:        I %B["P" K DO S DIC=U_$P(%B3,U,3),DIC(0)="M"_$E("L",%B'["'") D AST:%B["*",DQ
        !            43:        I %B["D" S %DT=$P($P($P(%B3,U,5,99),"%DT=""",2),"""",1) D HELP^%DTC
        !            44:        I %B["S" X:$D(^DD(%B1,%B2,12.1)) ^(12.1) S A0=$$EZBLD^DIALOG(8068)_" " D MSG F %C=1:1 S Y=$P($P(%B3,U,3),";",%C) Q:Y=""  S %I=$P(Y,":",2),Y=$P(Y,":") I 1 X:$D(DIC("S")) DIC("S") I  S A0=Y_$E("         ",$L(Y)+1,999)_%I D MSG
        !            45:        I %B["V" S A0="" D MSG S X1=X,DU=%B1,D=%B2,DZ=X D V^DIEQ S X=X1
        !            46:        Q
        !            47: DQ     N %W S:$D(D)[0 D="B" S (X1,DZ)=X D DQ^DICQ S DDSV=DIC K DD,% S:$D(X1) X=X1
        !            48:        Q
        !            49: AST    F %=" D ^DIC"," D IX^DIC"," D MIX^DIC1" S Y=$F(%B3,%),%=$L(%)+1 Q:Y
        !            50:        Q:'Y
        !            51:        I $D(DDS) S A0=" " D MSG
        !            52:        X $P($E(%B3,1,Y-%),U,5,99)
        !            53:        Q
        !            54: QUES   ;
        !            55:        I %T D QU
        !            56:        I X="??",$D(DIR("??")) D:$P(DIR("??"),U)]"" HF S:$P(DIR("??"),U,2)]"" A0(0)=1,A0=$P(DIR("??"),U,2,99) D:$P(DIR("??"),U,2)]"" MSG Q
        !            57:        I %T="P" S DIC=%B1,DIC(0)=%B2 S:$D(DIR("S"))#2 DIC("S")=DIR("S") D DQ K DIC("S")
        !            58:        I '%N S A0="" D MSG
        !            59:        I X'["?" W $C(7)
        !            60:        I %N S A0(0)=1,A0=$E(%W,2,999) D MSG
        !            61:        D:'%N WRAP:%W]"" I %T["S",(%A["A"!(%A["B")) D S
        !            62:        Q
        !            63: WRAP   I $D(DIR("?"))=11 F %I=1:1 Q:'$D(DIR("?",%I))  S A0=DIR("?",%I) D MSG
        !            64:        K %Y S %J=$S($D(IOM):IOM,1:80)-6,%Y=1 S X1=$S($D(DIR("?"))=11:DIR("?"),1:%W)
        !            65:        I '%N,$D(DIR("?"))'=11,"FNDL"[%T S X1=X1_"."
        !            66: W1     S:$L(X1)<%J %Y(%Y)=X1 I $L(X1)'<%J F %I=%J:-1:0 I $E(X1,%I)?1P S %Y(%Y)=$E(X1,1,%I),X1=$E(X1,%I+1,999),%Y=%Y+1 G W1
        !            67:        F %I=1:1:%Y S A0=%Y(%I) D MSG
        !            68:        I $D(DDS),%T="S" D
        !            69:        . S A0="Choose from:" D MSG
        !            70:        . F %I=1:1 Q:$P(%B,";",%I,999)=""  D
        !            71:        .. S %Y=$P(%B,";",%I),Y=$P(%Y,":") Q:Y=""
        !            72:        .. I $D(DIR("S"))#2 X DIR("S") E  Q
        !            73:        .. S A0=Y_$J("",9-$L(Y))_$P(%Y,":",2) D MSG
        !            74:        K %Y,%,X1
        !            75:        Q
        !            76: HF     S XQH=$P(DIR("??"),U) N %A,%B,%E,DIR D EN1^XQH
        !            77:        Q
        !            78: MSG    ;
        !            79:        I $D(DDS),A0]"" S DDH=$G(DDH)+1,DDH(DDH,$S($D(A0)>9:"X",1:"T"))=A0
        !            80:        I '$D(DDS),$D(A0)>9 X A0
        !            81:        I '$D(DDS),$D(A0)=1 W !,A0
        !            82:        K A0
        !            83:        Q
        !            84: S      W !!?5,"Select one of the following:",!!
        !            85:        F %I=1:1 Q:$P(%B,";",%I,999)=""  D
        !            86:        . S Y=$P($P(%B,";",%I),":") Q:'$L($P(%B,";",%I,99))
        !            87:        . I $D(DIR("S"))#2 X DIR("S") E  Q
        !            88:        . W ?10,Y,?20,$P($P(%B,";",%I),":",2),!
        !            89:        Q
        !            90: Q      G ^DIRQ
        !            91:        ;
        !            92:        ;#8068  Choose from