Return to DICM2.m CVS log

Up to [Coherent Logic Development] / freem_fileman / USER

Restructure repository

    1: DICM2	;SFISC/XAK-LOOKUP FOR VAR PTR ;8/13/90  3:46 PM
    2: 	;;21.0;VA FileMan;;Dec 28, 1994
    3: 	;Per VHA Directive 10-93-142, this routine should not be modified.
    4: 	;
    5: 	S DIVDO=+DO(2),DIVDIC=DIC,DIVY=%Y N DIADD,DS
    6: 	F %="DR","S","A","V" I $D(DIC(%)) S DIV(%)=DIC(%)
    7: 	K DIC("W"),DIC("S"),DIC("DR"),DO,DUOUT S DIEX=X G ALL:X'["."
    8: 	I $P(X,".",2,999)="" S Y=-1 G Q
    9: V	S DIVP=$P(DIEX,"."),A9=1
   10: 	I DIVP="" G ALL
   11: 	I $D(^DD(DIVDO,DIVY,"V","P",DIVP)) S (DIVP,DIVPDIC)=+$O(^(DIVP,0)),DIVPDIC=$S($D(^DD(DIVDO,DIVY,"V",DIVP,0)):^(0),1:"") G Q:'DIVPDIC S X=$P(DIEX,".",2,999),A9=0 D ^DICM3 G Q
   12: 	S DIVP2="",DIVP=$P(DIEX,".")
   13: 	F %=0:0 S DIVP2=$O(^DD(DIVDO,DIVY,"V","M",DIVP2)) Q:DIVP2=""  I $P(DIVP2,DIVP)="" S (DIVP,DIVPDIC)=+$O(^(DIVP2,0)),DIVPDIC=$S($D(^DD(DIVDO,DIVY,"V",DIVP,0)):^(0),1:""),X=$P(DIEX,".",2,999),A9=0 G Q:'DIVPDIC D ^DICM3 G Q:Y>0 S DIVP=$P(DIEX,".")
   14: 	F DIVP=0:0 S DIVP=+$O(^DD(DIVDO,DIVY,"V",DIVP)) Q:'DIVP  I $D(^(DIVP,0)) S DIVPDIC=^(0) I $D(^DIC(+DIVPDIC,0)) S %=$P(^(0),U) I $P(%,$P(DIEX,"."))="" S X=$P(DIEX,".",2,999),A9=0 D ^DICM3 G Q:Y>0 S X=DIEX
   15: 	I A9 S X=DIEX,A9=0 G ALL
   16: 	K X G Q
   17: ALL	F DIVP1=0:0 S DIVP1=+$O(^DD(DIVDO,DIVY,"V","O",DIVP1)) Q:'DIVP1  S DIVP=+$O(^(DIVP1,0)) I $D(^DD(DIVDO,DIVY,"V",DIVP,0)) S DIVPDIC=^(0) D ^DICM3 G Q:Y>0!(%<0)!$D(DUOUT) S X=DIEX
   18: 	G Q:DICR>1!$D(DICR(DICR,"V")) S DICR(DICR,"V")=1 K DIVP G ALL
   19: 	;
   20: 	;
   21: Q	I '$D(DUOUT),Y<0,DICR<2,'$D(DICR(DICR,"V")) S DICR(DICR,"V")=1 K DIVP G V
   22: 	K:Y<0 X S DICR(DICR,"V")=1
   23: 	F %="DR","S","A","V" I $D(DIV(%)) S DIC(%)=DIV(%)
   24: QQ	K:Y DICR(DICR,6)
   25: 	K DUOUT,DIVP,DIVDIC,DIVY,DO,DIVDO,DIVPDIC,DIEX,DIVP1,DIVP2,DIV,A9 Q
   26: 	;
   27: NAME	;DETERMINE EXTERNAL FORM FROM INTERNAL FOR VP
   28: 	S DINAME=DIY Q:'DIY  S %=$P(DIY,";",2),DINAME="^"_%_+DIY_",0)",DINAME=$S($D(@DINAME)#2:$P(^(0),U,1),1:DIY),%=$S($D(@("^"_%_"0)")):$P(^(0),U,2),1:"") Q:%=""
   29: 	I %["P"!(%["S")!(%["D") S C=$P(^DD(+%,.01,0),U,2),%YYY=DIY,%YY=Y,Y=DINAME D Y^DIQ S DINAME=Y,DIY=%YYY,Y=%YY,C="," K %YY,%YYY
   30: 	Q
   31: DQ	;