Return to DICN1.m CVS log

Up to [Coherent Logic Development] / freem_fileman

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