Return to DIC.m CVS log

Up to [Coherent Logic Development] / freem_fileman / USER

Restructure repository

    1: DIC	;SFISC/XAK,SEA/TOAD-VA FileMan: Lookup, Part 1 ;11/16/94  11:30
    2: 	;;21.0;VA FileMan;;Dec 28, 1994
    3: 	;Per VHA Directive 10-93-142, this routine should not be modified.
    4: 	N D
    5: 	S D="B" K DF,DS,DIROUT,DTOUT,DUOUT
    6: EN	K DO,DICR S U="^" S:DIC DIC=^DIC(DIC,0,"GL") D PGM^DIC2 I $D(DIPGM) S DIPGM(0)=1 G @DIPGM
    7: 	I '$D(@(DIC_"0)")),'$D(DIC("P")),$E(DIC,1,6)'="^DOPT(" S Y=-1 G Q^DIC2
    8: ASK	I DIC(0)["A" W ! D ^DIC1
    9: 	I $D(DIADD),X'["""",U'[X,X'?."?" S X=""""_X_""""
   10: X	;
   11: 	D DO^DIC1:'$D(DO) I U'[X,X'?."?",$D(^DD(+DO(2),.01,7.5)) X ^(7.5) G:'$D(X) BAD^DIC1
   12: 	D PGM^DIC2 I $D(DIPGM) S DIPGM(0)=2 G @DIPGM
   13: RTN	D:'$D(DO) DO^DIC1
   14: 	G O^DIC1:X'?.ANP,N:$L(X)>30
   15: 	I X?.NP G NO:X="",N:U[X,NUM:+X=X&(X>0),^DICQ:X?1."?" I X=" ",$L(DIC)<29,$D(^DISV(DUZ,DIC))#2 S Y=+^(DIC) D S G GOT^DIC2:$T,BAD^DIC1
   16: F	;
   17: 	S (DD,DS)=0
   18: T	S Y=$O(@(DIC_"D,X,0)")),DIX=X S:Y="" Y=-1 I Y'<0 G DIY:$O(^(Y))]""!((DIC(0)'["O")&(DIC(0)["E")) D MN I  G K:DS S DS=1 G GOT^DIC2
   19: DIX	I DIC(0)'["X" S:X?.N&(DO(2)'["D")&'$D(DIDA) DIX=$O(@(DIC_"D,DIX_"" "")"),-1) S DIX=$O(@(DIC_"D,DIX)")) I $P(DIX,X)="",DIX'="" S Y=$O(^(DIX,0)) S:Y="" Y=-1 G DIY
   20: M	I DIC(0)["M" S D=$S($D(DID):$P(DID,U,DID(1)),1:$O(@(DIC_"D)"))) S:$D(DID) DID(1)=DID(1)+1
   21: 	I DIC(0)["M",D]"" G M:$D(@(DIC_"D)"))-10,T:X'?.NP,T:+X'=X D DO^DIC1:'$D(DO) S Y=$O(^DD(+DO(2),0,"IX",D,0)) S:Y="" Y=-1 G T:$O(^(Y,0))="",T:'$D(^DD(Y,$O(^(0)),0)),M:$P(^(0),U,2)["P",T
   22: 	D D G G:DS=1,Y^DIC1:DS
   23: N	I X[U S DUOUT=1 G NO
   24: 	D DO^DIC1:'$D(DO) I X?1"`".NP S Y=$E(X,2,30),DZ=0 G A:Y="" D S S DS=1,DD=Y G GOT^DIC2:$T I DIC(0)'["L" W:DIC(0)["Q" $C(7),$S('$D(DDS):"  ??",1:"") G A
   25: 	G ^DICQ:X?."?",^DICM
   26: NUM	D DO^DIC1:'$D(DO) G F:DO(2)<0!$D(DF) S DD=$D(^DD(+DO(2),.001)),DS=$P(^(.01,0),"^",2) I $D(@(DIC_"X)")) G:'DD P:DS["N"!('$O(^("A["))&($O(^("A["))]"")) S Y=X D S G GOT^DIC2:$T
   27: P	I DS["P"!(DS["V"),DIC(0)'["U" S (DD,DS)=0 G M
   28: 	G F
   29: 1	;
   30: 	D S G GOT^DIC2:$T,F
   31: MN	S DZ=$S(DIC(0)["D":1,$D(^(Y))-1:0,1:^(Y)),DIYX=0 D:'$D(DO) DO^DIC1
   32: 	I 'DZ,'$D(DO("SCR")),$L(DIX)<30,D="B",'$D(DIC("S")),'$D(@(DIC_"Y,-9)")) S DIY="" Q
   33: 	D S S:D="B"&'DZ&($P(DIY,DIX)="") DIY=$P(DIY,DIX,2,9),DIYX=1
   34: 	Q
   35: S	D:'$D(DO) DO^DIC1 I $D(@(DIC_"Y,0)")) S DIY=$P(^(0),U)
   36: 	E  S DIY="" Q
   37: 	I '$D(^(-9)) X:$D(DIC("S")) DIC("S") K DIAC,DIFILE Q:'$T!'$D(DO("SCR"))  I $D(@(DIC_"Y,0)")) X DO("SCR")
   38: 	Q
   39: Y	S Y=$O(@(DIC_"D,DIX,Y)")) S:Y="" Y=-1
   40: DIY	I Y<0 G DIX:DIC(0)'["O"&(DIC(0)["E"),G:DS=1&(D="B")&(DIX=X),DIX
   41: 	D MN E  G Y
   42: K	F DZ=1:1:DS I $D(DS(DZ)),+DS(DZ)=Y,DIC(0)'["C" G Y
   43: 	D DS^DICN1:'$D(DISMN) I $S<DISMN F DZ=1:1:DS-7 K DS(DZ),DIY(DZ),DIYX(DZ)
   44: 	S DS=DS+1,DS(DS)=Y_"^"_$P(DIX,X,2,99),DIY(DS)=DIY S:DIY]""&$G(DIYX) DIYX(DS)=1 G Y:DS#5-1,Y:DS=1,Y:DIC(0)["Y",Y^DIC1
   45: G	S DIY=1,DIX=X I DIC(0)["E",DIC(0)'["D",'$D(DICRS) S:$D(DDS) DST=$S($D(DST)#2:DST_"  ",1:"")_X_$P(DS(1),U,2,99)_$S($G(DIYX(1)):$G(DIY(1)),1:"") W:'$D(DDS) $P(DS(1),U,2,99)
   46: C	S Y=+DS(DIY),X=X_$P(DS(DIY),"^",2),DIYX=$G(DIYX(DIY)),DIY=DIY(DIY)
   47: 	G GOT^DIC2
   48: 	;
   49: D	S D=$S($D(DF):DF,1:"B") S:$D(DID(1)) DID(1)=2 Q
   50: IX	K DTOUT,DUOUT S DF=D G EN
   51: A	K DIY,DIYX,DS I DIC(0)["A" D D G ASK
   52: NO	S Y=-1 G Q^DIC2
   53: 	;
   54: 	;DBS entry points
   55: 	;
   56: LIST(DIFILE,DIFIEN,DIFIELDS,DIFLAGS,DINUMBER,DIFROM,DIPART,DINDEX,DICALSCR,DIWRITE,DILIST,DIMSGA)	;SEA/TOAD
   57: 	;ENTRY POINT--return a list of entries from a file
   58: 	;subroutine, DIFROM passed by value
   59: 	G IN^DICL
   60: 	;
   61: FIND1(DIFILE,DIEN,DIFLAGS,DIVALUE,DINDEX,DISCREEN,DIMSGA)	;SEA/TOAD
   62: 	;ENTRY POINT--find a single entry in the file
   63: 	;function, all passed by value
   64: 	I '$D(DIQUIET) N DIQUIET S DIQUIET=1
   65: 	I '$D(DIFM) N DIFM S DIFM=1 D INIZE^DIEFU
   66: 	I $G(DIMSGA)'="" D 
   67: 	.K @DIMSGA@("DIERR"),@DIMSGA@("DIHELP"),@DIMSGA@("DIMSG")
   68: 	N DIERN,DIFIND,DIPE,DITARGET
   69: 	D FIND^DICF($G(DIFILE),$G(DIEN),"",$G(DIFLAGS)_"f",$G(DIVALUE),1,$G(DINDEX),$G(DISCREEN),"","DITARGET")
   70: 	I $D(DIERR) S DIFIND=""
   71: 	E  I $P($G(DITARGET(0)),U,3) K DITARGET S DIFIND="" D
   72: 	.S DIERN=299
   73: 	.S DIPE(1)=$G(DIVALUE)
   74: F1	.S DIPE("FILE")=$G(DIFILE)
   75: 	.S DIPE("IEN")=$G(DIEN)
   76: 	.D BLD^DIALOG(DIERN,.DIPE,.DIPE)
   77: 	.Q
   78: 	E  S DIFIND=+$G(DITARGET(1))
   79: 	I $G(DIMSGA)'="" D CALLOUT^DIEFU(DIMSGA)
   80: 	Q DIFIND
   81: 	;
   82: FIND(DIFILE,DIEN,DIFLDS,DIFLAGS,DIVALUE,DIMAX,DIFORCE,DISCREEN,DID,DILIST,DIMSGA)	;SEA/TOAD
   83: 	;ENTRY POINT--in a file find entries that match a value
   84: 	;procedure, all passed by value
   85: 	G FINDX^DICF
   86: 	;