Return to DIC.m CVS log

Up to [Coherent Logic Development] / freem_fileman

Annotation of freem_fileman/DIC.m, revision 1.1.1.1

1.1       snw         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:        ;