Return to DIR1.m CVS log

Up to [Coherent Logic Development] / freem_fileman

Annotation of freem_fileman/DIR1.m, revision 1.1.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