Return to DICN1.m CVS log

Up to [Coherent Logic Development] / freem_fileman

Annotation of freem_fileman/DICN1.m, revision 1.1.1.1

1.1       snw         1: DICN1  ;SFISC/GFT-PROCESS DIC("DR") ;10/4/94  11:09
                      2:        ;;21.0;VA FileMan;;Dec 28, 1994
                      3:        ;Per VHA Directive 10-93-142, this routine should not be modified.
                      4:        K DIDA,DICRS,Y,%RCR
                      5:        F Y="DIADD","I","J","X","DO","DC","DA","DE","DG","DIE","DR","DIC","D","D0","D1","D2","D3","D4","D5","D6","DI","DH","DIA","DICR","DK","DIK","DL","DLAYGO","DM","DP","DQ","DU","DW","DIEL","DOV","DIOV","DIEC","DB","DV","DIFLD" S %RCR(Y)=""
                      6:        S DZ="W !?3,$S("""_$P(DO,U)_"""'=$P(DQ(DQ),U):"""_$P(DO,U)_""",1:"""")_"" ""_$P(DQ(DQ),U)_"": """
                      7:        I $D(DIC("DR")) S DD=DIC("DR")
                      8:        E  S DD="",%=0,Y=0 F  S Y=$O(^DD(+DO(2),0,"ID",Y)) S:Y="" Y=-1 Q:Y'>0  D CKID I '$D(%) D W G BAD
                      9:        S %RCR="RCR^DICN1" D STORLIST^%RCR G D^DICN:$D(Y)<9
                     10: BAD    S:$D(D)#2 DA=D K Y I '$D(DO(1)) S Y=-1 G Q^DIC2
                     11:        K DO G A^DIC
                     12:        ;
                     13: CKID   I $D(DUZ(0)),DUZ(0)'="@",$D(^DD(+DO(2),Y,9)),^(9)]"" F %=1:1 I DUZ(0)[$E(^(9),%) Q:$L(^(9))'<%  K:$P(^(0),U,2)["R" % G Q
                     14:        S DD=DD_Y_";"
                     15: Q      Q
                     16:        ;
                     17: W      S A1="T",DST="SORRY!  A VALUE FOR '"_$P(^(0),U,1)_"' MUST BE ENTERED," W:'$D(DDS) ! D H
                     18:        S A1="T",DST="BUT YOU DON'T HAVE 'WRITE ACCESS' FOR THIS FIELD" W:'$D(DDS) !,?6 D H D:$D(DDS) LIST^DDSU
                     19:        S %RCR="D^DICN1" D STORLIST^%RCR Q
                     20:        ;
                     21: H      I $D(DDS) S DDH=$S($D(DDH):DDH+1,1:1),DDH(DDH,A1)=DST K A1,DST Q
                     22:        W DST K A1,DST Q
                     23: RCR    ;
                     24:        K DR,DIADD,DQ,DG,DE,DO S DIE=DIC,DR=DD,DIE("W")=DZ K DIC I $D(DIE("NO^")) S %RCR("DIE(""NO^"")")=DIE("NO^")
                     25:        S DIE("NO^")="OUTOK"
                     26:        D:$D(DDS) CLRMSG^DDS D ^DIE K DIE("W"),DIE("NO^")
                     27:        D:$D(DDS)
                     28:        . I $Y<IOSL D CLRMSG^DDS Q
                     29:        . D REFRESH^DDSUTL
                     30: A      I '$D(DA) S Y(0)=0 Q
                     31:        Q:$D(Y)<9&'$D(DTOUT)&'$D(DIC("W"))
                     32: ZAP    S DIK=DIE,A1="T",DST=$C(7)_"   <'"_$P(@(DIK_"DA,0)"),U,1)_"' DELETED>" W:'$D(DDS) !?3 D H D:$D(DDS) LIST^DDSU
                     33:        D ^DIK S Y(0)=0 K DST Q
                     34:        ;
                     35: D      S DIE=DIC G ZAP
                     36:        ;
                     37: RIX    ;
                     38:        K %RCR F %="D0","Y","DIC","DIU","DIV","DO","D","DD","DICR","X" S %RCR(%)=""
                     39:        S %RCR="RR^DICN1",DZ=^(1) D STORLIST^%RCR G IX^DICN
                     40:        ;
                     41: RR     X DZ Q
                     42:        ;
                     43: NUM    ;
                     44:        I '$D(DD),DIC="^DIC(",'$D(DO(3)) D DIC G F2^DICN
                     45:        S %=$P(^DD(+Y,.001,0),U,2),X=$S(%'["N"!(%["O"):0,1:X),%Y=X I X F %=1:1 D N Q:$D(X)  S X=0 Q:%>999  S X=%Y+DIY,%Y=X
                     46:        S DST="   "_$P(DO,U)_" "_$P(^DD(+Y,.001,0),U)_": " S:X DST=DST_X_"// " I '$D(DDS) W !,DST K DST R Y:$S($D(DTIME):DTIME,1:300) E  S DTOUT=1,Y=U W $C(7)
                     47:        I $D(DDS) S A1="Q",DST=3_U_DST D H,LIST^DDSU S Y=$S($D(DTOUT):U,1:%) K %
                     48:        I Y="?" G WR
                     49:        G BAD^DIC1:Y[U S:Y]"" X=Y D N I '$D(X) W $C(7) W:'$D(DDS) "??" G WR
                     50:        G LOCK^DICN
                     51:        ;
                     52: WR     S DST="" S:$D(^DD(+DO(2),.001,3)) DST="     "_^(3)
                     53:        I '$D(DDS) W:DST]"" !?5,DST X:$D(^(4)) ^(4) K DST
                     54:        I $D(DDS) S A1=+Y D H S:$D(^(4)) DDH("ID")=^(4) D LIST^DDSU
                     55:        G F1^DICN
                     56:        ;
                     57: N      X:$D(^DD(+$P(DO,U,2),.001,0)) $P(^(0),U,5,99) I $D(X),$L(X)<15,+X=X,X>0,X>1!(DIC'="^DIC(") Q
                     58:        K X Q
                     59:        ;
                     60: DS     I '$D(DISMN) S DISMN=1000 D OS^DII:'$D(DISYS) S DISMN=$S(+$P(^DD("OS",DISYS,0),U,2):$P(^(0),U,2),1:DISMN)
                     61:        Q
                     62: DIC    ;
                     63:        S DO(3)=1
                     64:        I $S($D(^VA(200,DUZ,1))#2:1,1:$D(^DIC(3,DUZ,1))#2),$P(^(1),U) S DIY=.1,X=+$P(^(1),U) Q
                     65:        I $D(^DD("SITE",1)),X\1000'=^(1) S X=^(1)*1000,%=0
                     66:        Q