Return to DIC1.m CVS log

Up to [Coherent Logic Development] / freem_fileman

Annotation of freem_fileman/DIC1.m, revision 1.1.1.1

1.1       snw         1: DIC1   ;SFISC/GFT-READ X, SHOW CHOICES ;09:14 AM  7 Nov 1994
                      2:        ;;21.0;VA FileMan;;Dec 28, 1994
                      3:        ;Per VHA Directive 10-93-142, this routine should not be modified.
                      4:        K DUOUT,DTOUT I $D(DIC("A")) S DD=DIC("A") G B
                      5:        D DO S Y=$P(DO,U) I D="B",DO(2)>1.9 S X=$P(^DD(+DO(2),.01,0),U) I X'[Y,Y'[X S Y=Y_" "_X
                      6:        S DD=$$EZBLD^DIALOG(8042,Y)
                      7: B      I $D(DIC("B")),DIC("B")]"" S Y=DIC("B"),X=$O(@(DIC_"D,Y)")),DIY=$S($D(^(Y)):Y,$F(X,Y)-1=$L(Y):X,$D(@(DIC_"Y,0)")):$P(^(0),U),1:Y) W DD D WR^DIC2 R "// ",X:$S($D(DTIME):DTIME,1:300) G T:'$T,DO:X]"" S X=DIY S:DIC(0)'["O" DIC(0)=DIC(0)_"O" G DO
                      8:        W DD R X:$S($D(DTIME):DTIME,1:300) E  G T
                      9: DO     ; GET FILE ATTR
                     10:        Q:$D(DO)  I $D(@(DIC_"0)")) S DO=^(0)
                     11:        E  S DO="0^-1" I $D(DIC("P")) S DO=U_DIC("P"),^(0)=DO
                     12: DO2    S DO(2)=$P(DO,U,2) I DO?1"^".E S DO=$O(^DD(+DO(2),0,"NM",0))_DO
                     13:        I DO(2)["s",$D(^DD(+DO(2),0,"SCR")) S DO("SCR")=^("SCR")
                     14:        Q:DO(2)'["I"!$D(DIC("W"))  Q:'$D(^DD(+DO(2),0,"ID"))  S %=0,DIC("W")="" I DO(2)["P" D WOV S %=+DO(2),%Y=DIC G P
                     15: W      ;
                     16:        S %=$O(^DD(+DO(2),0,"ID",%)) I %]"" G WOV:$L(DIC("W"))+$L(^(%))>224 S:^(%)'="W """"" DIC("W")=DIC("W")_" W ""   "" "_^(%) G W
                     17:        S DIC("W")=$E(DIC("W"),2,999) Q
                     18: P      I %,$D(^DD(%,.01,0)) S %=+$P($P(^(0),U,2),"P",2) I $D(^DIC(%,0,"GL")) S %W=^("GL") D Q:%W]"" G P
                     19:        Q
                     20: Q      S %W1=%W
                     21:        I %W[$C(34) S %W1=$P(%W,$C(34))_$C(34,34)_$P(%W,$C(34),2)_$C(34,34)_$P(%W,$C(34),3,9)
                     22:        I $L(DIC("W"))<200 S DIC("W")=DIC("W")_" I '$D(DICR) S %Y=+"_%Y_"%Y,0) I $D("_%W_"%Y,0)) S %W="_%_",%Z="""_%W1_""" D WOV^DICQ1",%Y=%W
                     23:        K %W1 Q
                     24: WOV    S DIC("W")="S %W=+DO(2),%Y=Y,%Z=DIC D WOV^DICQ1" Q
                     25:        ;
                     26: RENUM  ;
                     27:        D DO I '$D(DF),X?.NP,^DD(+DO(2),.01,0)["DINUM",$D(@(DIC_"X)")) S Y=X G 1^DIC
                     28:        G F^DIC
                     29:        ;
                     30: DT     S DST=DST_$$FMTE^DILIBF(%,"7S")
                     31:        I '$D(DDS) W DST S DST=""
                     32:        Q
                     33: Y      ;
                     34:        S DZ=Y,DD=$O(DS(DD)),DDH=DD-1,Y=+DS(DD),DIYX=0
                     35:        I DIC(0)["E" W:'$D(DDS) !?5,DD,?9 D E
                     36:        S Y=DZ I DIC(0)["Y" G Y:DD<DS F Y=DS:-1 G Q^DIC2:'Y S Y(+DS(Y))=""
                     37:        G N:DIC(0)'["E" I DS>DD G Y:DD#5 W:'$D(DDS) !,"TYPE '^' TO STOP, OR"
                     38:        I $D(DDS) S DDD=2,DDC=5 D LIST^DDSU K DDD,DDC I $D(DTOUT) D T G N
                     39:        I '$D(DDS) W !,"CHOOSE "_$O(DS(0))_"-"_DD R ": ",DIY:$S($D(DTIME):DTIME,1:300) E  D T G N
                     40:        I DIY=""!(U[DIY)!$D(DUOUT) S:DIY=U DUOUT=1 G:DD=DS L^DICM:DO(2)["O"&(DO(2)'["A"),A^DIC G Y^DIC:DIY="" S X=U G A^DIC
                     41:        I DIY?1."?" S DIC1Q=1 I DIC(0)_$G(DICR(1,0))'["A" D
                     42:        . S DIY=X I '$D(DICRS) N DIY,X,D,DZ S D=$S($D(DF):DF,1:"B"),DZ="?" D DQ^DICQ
                     43:        I DIY'?1.N&'$D(DICRS)!$D(DIC1Q) S D=$S($D(DF):DF,1:"B"),X=DIY K DIC1Q,DIY,DS,DDH("ID") G X^DIC
                     44:        G BAD:'$D(DS(DIY)) S Y=+DS(DIY) K DIC("W"),DIVP1
                     45:        S:$D(DDS) DST=X_$P(DS(DIY),U,2,9)_$S($G(DIYX(DIY)):$G(DIY(DIY)),1:"")
                     46:        G C^DIC
                     47:        ;
                     48: E      S DST=""
                     49:        S %=$P(X,U,'$D(DICRS))_$P(DS(DD),U,2,9),DIY=$S(%=DIY(DD):"",DO(2)["D"&($D(DIDA)!(DIY(DD)="")):%,1:"")_DIY(DD)
                     50:        S:DO(2)'["D"&'$D(DIDA) DST=DST_%
                     51:        S:$G(DIYX(DD)) DST=DST_DIY(DD),DIY=""
                     52:        D DT:D'="B"&$D(DIDA),WO^DIC2
                     53:        Q
                     54:        ;
                     55: T      W $C(7) S X="",DTOUT=1 Q
                     56: OK     ;
                     57:        S %=1 I $D(DS),DS=1 S DST="         ...OK" D Y^DICN
                     58:        I %>0 G R^DIC2:%=1 S X=DIX G L^DICM
                     59: O      ;
                     60: BAD    I DIC(0)["Q" D
                     61:        . W:'$D(DUOUT) $C(7)_$S('$D(DDS):" ??",1:"")
                     62:        . I $D(Y),Y[U S Y=-1
                     63:        Q:$D(DTOUT)  G A^DIC
                     64: N      G NO^DIC
                     65: MIX    ;
                     66:        S DID=D_"^-1",DID(1)=2,D=$P(DID,U) G IX^DIC
                     67:        ;
                     68:        ;#8042  Select |filename|: