Return to DICN1.m CVS log

Up to [Coherent Logic Development] / freem_fileman / USER

Restructure repository

DICN1	;SFISC/GFT-PROCESS DIC("DR") ;10/4/94  11:09
	;;21.0;VA FileMan;;Dec 28, 1994
	;Per VHA Directive 10-93-142, this routine should not be modified.
	K DIDA,DICRS,Y,%RCR
	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)=""
	S DZ="W !?3,$S("""_$P(DO,U)_"""'=$P(DQ(DQ),U):"""_$P(DO,U)_""",1:"""")_"" ""_$P(DQ(DQ),U)_"": """
	I $D(DIC("DR")) S DD=DIC("DR")
	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
	S %RCR="RCR^DICN1" D STORLIST^%RCR G D^DICN:$D(Y)<9
BAD	S:$D(D)#2 DA=D K Y I '$D(DO(1)) S Y=-1 G Q^DIC2
	K DO G A^DIC
	;
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
	S DD=DD_Y_";"
Q	Q
	;
W	S A1="T",DST="SORRY!  A VALUE FOR '"_$P(^(0),U,1)_"' MUST BE ENTERED," W:'$D(DDS) ! D H
	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
	S %RCR="D^DICN1" D STORLIST^%RCR Q
	;
H	I $D(DDS) S DDH=$S($D(DDH):DDH+1,1:1),DDH(DDH,A1)=DST K A1,DST Q
	W DST K A1,DST Q
RCR	;
	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^")
	S DIE("NO^")="OUTOK"
	D:$D(DDS) CLRMSG^DDS D ^DIE K DIE("W"),DIE("NO^")
	D:$D(DDS)
	. I $Y<IOSL D CLRMSG^DDS Q
	. D REFRESH^DDSUTL
A	I '$D(DA) S Y(0)=0 Q
	Q:$D(Y)<9&'$D(DTOUT)&'$D(DIC("W"))
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
	D ^DIK S Y(0)=0 K DST Q
	;
D	S DIE=DIC G ZAP
	;
RIX	;
	K %RCR F %="D0","Y","DIC","DIU","DIV","DO","D","DD","DICR","X" S %RCR(%)=""
	S %RCR="RR^DICN1",DZ=^(1) D STORLIST^%RCR G IX^DICN
	;
RR	X DZ Q
	;
NUM	;
	I '$D(DD),DIC="^DIC(",'$D(DO(3)) D DIC G F2^DICN
	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
	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)
	I $D(DDS) S A1="Q",DST=3_U_DST D H,LIST^DDSU S Y=$S($D(DTOUT):U,1:%) K %
	I Y="?" G WR
	G BAD^DIC1:Y[U S:Y]"" X=Y D N I '$D(X) W $C(7) W:'$D(DDS) "??" G WR
	G LOCK^DICN
	;
WR	S DST="" S:$D(^DD(+DO(2),.001,3)) DST="     "_^(3)
	I '$D(DDS) W:DST]"" !?5,DST X:$D(^(4)) ^(4) K DST
	I $D(DDS) S A1=+Y D H S:$D(^(4)) DDH("ID")=^(4) D LIST^DDSU
	G F1^DICN
	;
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
	K X Q
	;
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)
	Q
DIC	;
	S DO(3)=1
	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
	I $D(^DD("SITE",1)),X\1000'=^(1) S X=^(1)*1000,%=0
	Q