Return to DIR1.m CVS log

Up to [Coherent Logic Development] / freem_fileman / USER

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

1.1     ! snw         1: DIR1   ;SFISC/XAK-READER-MAID (PROCESS DATATYPE) ;11/23/94  14:36
        !             2:        ;;21.0;VA FileMan;;Dec 28, 1994
        !             3:        ;Per VHA Directive 10-93-142, this routine should not be modified.
        !             4:        S %E=0 D @%T I %A["X"!'%E!(X?.UNP) K %BU,%K Q
        !             5:        S %M=X F %Y=1:1:$L(X) I $E(X,%Y)?1L S X=$E(X,1,%Y-1)_$C($A(X,%Y)-32)_$E(X,%Y+1,999)
        !             6:        G DIR1
        !             7: Y      ; YES/NO
        !             8: S      ; SET
        !             9:        I $L(X)>245 S %E=1 Q
        !            10:        I %T="S",$D(DIR("S"))#2 S DIC("S")=DIR("S")
        !            11:        I %A["M" S %BU=$$UP^DILIBF(%B)
        !            12:        S %BA=$S($D(DIC("S")):DIC("S"),1:"I 1")
        !            13:        S (%J,%K,DDH)=0,Y(0)=$P($P(";"_%B,";"_X_":",2),";") I Y(0)]"" S Y=X X %BA I  S %J=1
        !            14:        I '%J F %I=1:1 S %J=$P(%B,";",%I) Q:%J=""  S Y=$F(%J,":"_X) I Y S Y=$P(%J,":") X %BA I  S %K=%K+1,%K(%K)=%J
        !            15:        I %J="",$D(%BU),'%K F %I=1:1 S %J=$P(%BU,";",%I),%J1=$P(%B,";",%I) Q:%J=""  S Y=$F(%J,":"_X) I Y S Y=$P(%J1,":") X %BA I  S %K=%K+1,%K(%K)=%J1
        !            16:        I %K=1 S Y=$P(%K(1),":"),Y(0)=$P(%K(1),":",2)
        !            17:        I %K>1,$G(DIQUIET) S %E=1 Q
        !            18:        I %K>1 D CH Q:%E=1  I '$D(%K(%I)) S X=%I G S
        !            19:        I %J="",'%K S %E=1 Q
        !            20:        I %A'["V",$D(DDS)[0 W $S((%K=1!('%K))&($P(Y(0),X)=""):$E(Y(0),$L(X)+1,99),1:"  "_Y(0))
        !            21:        I %T="Y" S (%,Y)=+$$PRS^DIALOGU(7001,$E(X)) S:%<0 (%,Y)="" S:%=2 Y=0
        !            22:        I '%E,$G(%M)]"" S X=%M K %M
        !            23:        Q
        !            24:        ;
        !            25: CH     ;
        !            26:        N DIY,DDD,DDC,DS,DD
        !            27:        F %I=1:1:%K S A0="     "_%I_"   "_$P(%K(%I),":",2) D MSG
        !            28:        I '$D(DDS) S A0="Choose 1-"_%K_": " D MSG R %I:$S($D(DIR("T")):DIR("T"),'$D(DTIME):300,1:DTIME)
        !            29:        I $D(DDS) S DDD=2,DDC=5,(DS,DD)=%K D LIST^DDSU S %I=DIY
        !            30:        I U[%I!(%I?1."?") S X="?",%E=1 Q
        !            31:        I $D(%K(%I)) S Y=$P(%K(%I),":"),Y(0)=$P(%K(%I),":",2)
        !            32:        Q
        !            33:        ;
        !            34: MSG    ;
        !            35:        I $D(DDS),A0]"" S DDH=$G(DDH)+1,DS(DDH)=$P(%K(%I),":"),DDH(DDH,DDH)=$P(%K(%I),":",2)
        !            36:        I '$D(DDS) W !,A0
        !            37:        K A0
        !            38:        Q
        !            39:        ;
        !            40: L      ; LIST OR RANGE
        !            41:        D L^DIR3
        !            42:        Q
        !            43: D      ; DATE
        !            44:        D ^%DT I Y<0 S %E=1 Q
        !            45:        I %D1["NOW"!(%D2["NOW")&($P("NOW",$$UP^DILIBF(X))="") S:%D1["NOW" %B1=Y S:%D2["NOW" %B2=Y
        !            46:        I %B1,Y<%B1 S %E=1 S:'%N %W="Response must not be previous to "_+$E(%B1,4,5)_"/"_+$E(%B1,6,7)_"/"_$E(%B1,2,3) Q
        !            47:        I Y>%B2 S %E=1 S:'%N %W="Response must not be following "_+$E(%B2,4,5)_"/"_+$E(%B2,6,7)_"/"_$E(%B2,2,3)
        !            48:        S Y(1)=Y X ^DD("DD") S Y(0)=Y,Y=Y(1) K Y(1)
        !            49:        Q
        !            50:        ;
        !            51: N      ; NUMERIC
        !            52:        I $L($P(X,"."))>24 S %E=1 Q
        !            53:        I X'?.1"-".N.1".".N S %E=1 Q
        !            54:        I X>%B2!(X<%B1) S %E=1 S:'%N %W="Response must be no "_$S(X>%B2:"greater",1:"less")_" than "_$S(X>%B2:%B2,1:+%B1) Q
        !            55:        I '%E,($L($P(+X,".",2))>%B3) S %E=1 S:'%N %W="Response must be with no more than "_+%B3_" decimal digit"_$S(%B3>1:"s",1:"") Q
        !            56:        S Y=+X
        !            57:        Q
        !            58:        ;
        !            59: F      ; FREETEXT
        !            60:        S Y=X I X[U,%A'["U" S %E=1
        !            61:        S:'%N %W="This response must have at least "_+%B1_" character"_$S(+%B1>1:"s",1:"")_" and no more than "_%B2_" characters"_$S(%A'["U":" and must not contain embedded uparrow",1:"")
        !            62:        I $L(X)<%B1!($L(X)>%B2) S %E=1
        !            63:        Q
        !            64:        ;
        !            65: E      ; END-OF-PAGE
        !            66:        S Y=X="" S:X=U (DUOUT,DIRUT)=1 I $L(X),X'=U S %E=1
        !            67:        Q
        !            68:        ;
        !            69: P      ; POINTER
        !            70:        S:'$D(DDS) %B2=$P(%B2,"L")_$P(%B2,"L",2)
        !            71:        I %B2["A" S %B2=$P(%B2,"A")_$P(%B2,"A",2)
        !            72:        S:$D(DIR("S"))#2 DIC("S")=DIR("S")
        !            73:        S DIC=%B1,DIC(0)=%B2,%C=X D P1 S X=%C
        !            74:        S %E=Y<0
        !            75:        Q
        !            76: P1     N %A,%B,%C,%N,%P,%T,%W D ^DIC
        !            77:        Q
        !            78:        ;
        !            79: 1      ; DD
        !            80:        S %C=X N %W I %B["P"!(%B["V") N DIE
        !            81:        I %B["F" S Y=X I X[U,$P($P(%B3,U,4),";",2)'?1"E"1.N1","1.N S %E=1 Q
        !            82:        I %B["S" S %B=$P(%B3,U,3),%BU=$$UP^DILIBF(%B) X:$D(^DD(%B1,%B2,12.1)) ^(12.1) D S S X=Y,%B=$P(%B3,U,2) G R
        !            83:        I %B["P" S DIC=U_$P(%B3,U,3),DIE=DIC,DIC(0)=$E("L",%B'["'"&$D(DDS))_$E("E",$D(DIR("V"))[0)_"MZ" I %B'["*" D P1 S X=+Y,%E=Y<0
        !            84:        I %B["V" D
        !            85:        . N %A,%B,%C,%N,%P,%T,%W
        !            86:        . S (DIE,DP)=%B1,DIFLD=%B2,DQ=1
        !            87:        . D ^DIE3
        !            88:        . S %E=Y'>0 S:Y>0 Y(0)=$P(Y,U,2)
        !            89: R      D IT:'%E S X=%C
        !            90:        Q
        !            91: IT     D
        !            92:        . N %A,%B,%C,%N,%P,%T,%W
        !            93:        . I $P(%B3,U,2)["N",$P(%B3,U,5,99)'["$",X?.1"-".N.1".".N S X=+X
        !            94:        . X $P(%B3,U,5,99)
        !            95:        S %E='$D(X)
        !            96:        I '%E,%B'["P" S Y=X
        !            97:        I '%E,%B["D" X ^DD("DD") S Y(0)=Y,Y=X
        !            98:        Q
        !            99:        ;
        !           100:        ;#7001  Yes/No question