Return to DIC.m CVS log

Up to [Coherent Logic Development] / freem_fileman

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