Ignore:
Timestamp:
Dec 4, 2009, 12:11:15 AM (14 years ago)
Author:
George Lilly
Message:

revised back to 6/30/08 version

File:
1 edited

Legend:

Unmodified
Added
Removed

  • WorldVistAEHR/trunk/r/VA_FILEMAN-ARJT-DI-DD-DM-DT-%DT-%RCR/DICM.m

    r613 r623  
    1 DICM    ;SFISC/GFT,XAK,TKW-MULTIPLE LOOKUP FOR FLDS WHICH MUST BE TRANSFORMED ;4AUG2007
    2         ;;22.0;VA FileMan;**4,20,31,40,149,159**;Mar 30, 1999;Build 8
    3         ;Per VHA Directive 2004-038, this routine should not be modified.
    4         I '$D(DICR(1)),DIC(0)'["T" N DICR S DICR=0
    5         I $A(X)=34,X?.E1"""" G N
    6         I $G(^DD(+DO(2),0,"LOOK"))]"",^("LOOK")'="SOUNDEX" G @^("LOOK")
    7         I DIC(0)["U" S DD=0 G W
    8         I DIC(0)["T" G 2
    9 R       N DIFLAGS S DIFLAGS="4l"_$P("M^",U,DIC(0)["M")
    10         N DIFORCE D
    11         . S DIFORCE=0 I DIC(0)'["M"!($D(DID)) S DIFORCE=1
    12         . S DIFORCE(0)=$S(DIC(0)'["M":DINDEX,$D(DID):DID,1:"*"),DIFORCE(1)=1
    13         F  D 1 I DINDEX=""!(Y>0)!($G(DTOUT))!($G(DIROUT)) Q
    14         G 2
    15         ;
    16 1       N DS,%Y,DIV
    17         I $G(DINDEX("IXFILE")) S Y=DINDEX(1,"FILE"),%Y=DINDEX(1,"FIELD")
    18         E  S Y=$O(^DD(+DO(2),0,"IX",DINDEX,0)) S:Y="" Y=-1 S %Y=+$O(^(Y,0))
    19         I Y=-1,DINDEX="B" S Y=+DO(2),%Y=.01
    20         S:Y="" Y=-1 S:%Y="" %Y=-1
    21         I $D(DICR(U,Y,%Y,DINDEX)) S Y=-1
    22         E  I %Y=.01,DINDEX'="B",Y=+DO(2),$D(DICR(U,Y,%Y,"B")),$G(DINDEX(1,"TRANCODE"))="" S Y=-1
    23         I Y'<0 D
    24         . S DS=$G(^DD(Y,%Y,0)) I DS="" S Y=-1 Q
    25         . S %=DINDEX,DICR(U,Y,%Y,DINDEX)=0
    26         . I $D(^DD(Y,%Y,7)) D RS K DS X ^(7) Q
    27         . I $G(DINDEX("IXTYPE"))="S" D A,SOU^DICM1,D Q:Y>0  S Y=-1 Q
    28         . S DIX=Y,Y=$P(DS,U,2)
    29         . S Y=$S(Y["P":"P",Y["D":"D",Y["S":"S",Y["V":"V",1:"")
    30         . I Y]"" D A D:'Y ^DICM1,D Q:Y>0  S Y=-1 Q
    31         . I $G(DINDEX(1,"TRANCODE"))]"" S Y="T" D A,^DICM1 N DITRANX S DITRANX=1 D D
    32         . Q:Y>0  S Y=-1 Q
    33         Q:Y>0!(DIC(0)["T")  D
    34         . K DIV M DIV=X S DIV(1)=X N X,Y
    35         . D NXTINDX^DICF2(.DINDEX,.DIFORCE,.DIFILEI,DIFLAGS,.DIV,"*") Q
    36         Q
    37         ;
    38 2       D D^DIC0 S %=D
    39         G K:Y>0!($G(DIROUT))
    40         I X?.E1L.E,DIC(0)'["X" D  G K:$G(DIROUT)
    41         . D % N DIFILEI,DINDEX
    42         . S DIC(0)=$TR(DIC(0),"L"),X=$$UP^DILIBF(X) S:$G(DILONGX) DICR(DICR,"ORG")=X
    43         . D DIC Q
    44         I Y'>0,X["," S DS="",DIX=$P(X,",") I DIC(0)'["X",$L(DIX)<31 D  G K:$G(DIROUT) ;COMMA-PIECING
    45         . F %=2:1 S DD=$P(X,",",%) I DD'["""" D  Q:DD=""
    46         . . F  Q:$A(DD)-32  S DD=$E(DD,2,999)
    47         . . F  Q:$A(DD,$L(DD))-32  S DD=$E(DD,1,$L(DD)-1)
    48         . . I $L(DD)*2+$L(DS)>200!(DD="") S DD="" Q
    49         . . S DS=DS_" I %?.E1P1"""_DD_""".E!(D'=""B""&(%?1"""_DD_""".E))" Q
    50         . Q:DS=""  S %=D
    51         . D % S X=DIX N DILONGX
    52         . S DS="S %=$P(^(0),U)"_DS,DIC(0)=DIC(0)_"D" D 7 Q
    53         I Y'>0,$L(X)>30 D
    54         . N DILONGX S DILONGX=1
    55         . S %=D D % S Y="DICR("_DICR_")",DICR(DICR,"ORG")=X
    56         . S DS=$S(DIC(0)["X":"I DIVAL="_Y,1:"I '$L($P(DIVAL,"_Y_"))")
    57         . S:DIC(0)["O"&(DIC(0)'["E") DS=DS_",'$L($P(DIVAL,"_Y_",2))"
    58         . D 7 I Y>0!(X'?.E1L.E)!(DIC(0)["X") K DILONGX Q
    59         . S %=D D % S (X,DICR(DICR,"ORG"))=$$UP^DILIBF(X)
    60         . S Y="DICR("_DICR_",""ORG"")"
    61         . S DS="I '$L($P(DIVAL,"_Y_"))" S:DIC(0)["O"&(DIC(0)'["E") DS=DS_",'$L($P(DIVAL,"_Y_",2))"
    62         . D 7 K DILONGX Q
    63         ;
    64 K       S DICR=+$G(DICR),DD=$D(DICR(DICR,6)) K:'DICR DICR
    65         I Y>0 K DIC("W") D R^DIC2 Q
    66         I $G(DTOUT)!($G(DIROUT)) Q
    67 W       I @("$O("_DIC_"""A[""))]""""") G NL:DIC(0)["N",DD
    68         I DO(2)'["Z" S Y=0 D  Q:Y>0!($G(DIROUT))
    69 DINUM   .I $G(DINDEX("1","FIELD"))=.01,X?1.15NP,$P($G(^DD(+DO(2),.01,0)),U,5,99)["DINUM=X",$D(@(DIC_"X,0)")) D  Q:Y>0
    70         ..S Y=X I 1 X:$D(DIC("S")) DIC("S") I  S DIY="",DS=1 N DZ,DD D ADDKEY^DIC3,GOT^DIC2 Q
    71         ..S Y=0
    72         .N DIOUT S DIOUT=0 F DS=1:1 S @("Y=$O("_DIC_"Y))") D  Q:DIOUT
    73         . . I 'Y S Y=-1,DIOUT=1 Q
    74         . . W:DIC(0)["E"&(DS#20=0) ".."
    75         . . I $D(@(DIC_Y_",0)")),$P(^(0),U)=X X:$D(DIC("S")) DIC("S") I  S DIOUT=1
    76         . . I DIOUT S DIY="",DS=1 N DZ,DD D ADDKEY^DIC3,GOT^DIC2
    77         . . Q
    78 NL      I '$G(DICR) D NQ I $T D  Q:Y>0!($G(DTOUT))!($G(DIROUT))
    79         . N:'$G(DIASKOK) DIASKOK S (DS,DIASKOK)=1 N DZ,DD
    80         . D ADDKEY^DIC3,GOT^DIC2 Q
    81 DD      S Y=-1 I DD D BAD^DIC1 Q
    82 L       I DIC(0)["L" K DD G ^DICN
    83 B       D BAD^DIC1 Q
    84         ;
    85 N       D RS S X=$E(X,2,$L(X)-1),%=D D
    86         . I DINDEX("#")>1 S %Y=+$G(DINDEX(1,"FIELD")),DS=$G(^DD(+$G(DINDEX(1,"FILE")),%Y,0)) Q:DS]""
    87         . S DS=^DD(+DO(2),.01,0),%Y=.01 Q
    88         F Y="P","D","S","V" I $P(DS,U,2)[Y K:Y="P" DO D ^DICM1 S:$D(X)#2 DS("INT")=X Q
    89         I $D(X),DINDEX("#")>1 S X(1)=X
    90         S Y=-1 D L:$D(X),E
    91         I Y'>0 K DUOUT D BAD^DIC1 Q
    92         G 2
    93         ;
    94 A       ; Set variables needed for transforming date/set/ptr/var.ptr
    95         S DICR(DICR+1,4)=%
    96         D % K DF,DID,DINUM Q
    97         ;
    98 %       ; Set variables up before doing lookup w/transformed value
    99         I DIC(0)'["L" S DICR(DICR+1,8)=1
    100         E  I '$$OKTOADD^DICM0(.DIFILEI,.DINDEX,.DIFINDER) S DICR(DICR+1,8)=1
    101         I $G(DINUM)]"" S DICR(DICR+1,10)=DINUM
    102         I $D(DF) S DICR(DICR+1,9)=DF S:$G(DID)]"" DICR(DICR+1,9.1)=$G(DID(1))_U_DID
    103 RS      S DICR=DICR+1,DICR(DICR)=X,DICR(DICR,0)=DIC(0),DIC(0)=$TR(DIC(0),"A"),DIC(0)=$TR(DIC(0),"Q") Q
    104         ;
    105 D       S:$G(DICR(DICR,10))]"" DINUM=DICR(DICR,10)
    106         S (D,DF)=DICR(DICR,4) D
    107         . N T S T=$P($G(DS),U,2)
    108         . S DIC(0)=$TR(DIC(0),"M","") I T["V" S DIC(0)=$TR(DIC(0),"A","")
    109         . I D="B",T'["D",'$G(DITRANX) S DIC(0)=DIC(0)_"s"
    110         . I T["P"!(T["V")!(T["S") S DIC(0)=DIC(0)_"X"
    111         . Q
    112         I DICR(DICR,4)=DINDEX N I M I=DINDEX N DINDEX M DINDEX=I K I S DINDEX("START")=DINDEX
    113         E  N DINDEX D
    114         . S (DINDEX,DINDEX("START"))=DICR(DICR,4),DINDEX("WAY")=1
    115         . D INDEX^DICUIX(.DIFILEI,DIFLAGS,.DINDEX,"",.DIVALUE) Q
    116         I DINDEX("#")>1 S (DINDEX(1),DINDEX(1,"FROM"),DINDEX(1,"PART"))=$G(X)
    117 RCR     S:'$D(DIDA) DICRS=1
    118 DIC     ;
    119         I $D(DICR(DICR,8)) S DIC(0)=$TR(DIC(0),"L")
    120         S Y=-1 I $D(X) D  ;*159  WAS: I $D(X),$L(X)<31 D
    121         . N DIVAL S (DIVAL,DIVAL(1))=X N X S (X,X(1))=DIVAL
    122         . D RENUM^DIC1 K DIDA Q
    123         S:DIC(0)["L" DICR(DICR-1,6)=1 K:$D(DICR(DICR,4)) DF
    124 E       S D="B" Q:'$G(DICR)  ;**GFT
    125         S %=DICR,X=DICR(%),DIC(0)=DICR(%,0),DICR=%-1
    126         S:$G(DICR(%,10))]"" DINUM=DICR(%,10)
    127         S:$D(DICR(%,9)) (D,DF)=DICR(%,9) I $G(DICR(%,9.1))]"" S:$P(DICR(%,9.1),U)]"" DID(1)=$P(DICR(%,9.1),U) S DID=$P(DICR(%,9.1),U,2,999)
    128         K DICRS,DICR(%) D DO^DIC1:'$D(DO(2)) Q
    129         ;
    130 NQ      I $L(X)<14,X?.NP,+X=X,@("$D("_DIC_"X,0))") S Y=X D S^DIC3
    131         Q
    132         ;
    133 SOUNDEX I DIC(0)["E",'$D(DICRS) W "  " D RS,SOU S DIC(0)=$TR(DIC(0),"L") D RCR Q:Y>0
    134         G R
    135         ;
    136 7       S Y=-1 N % S %=$S($D(DIC("S")):DIC("S"),1:1)
    137         I $D(DS),'$D(DIC("S1")) D
    138         . S DIC("S")=DS I '% S DIC("S")=DIC("S")_" X DIC(""S1"")",DIC("S1")=%
    139         . I X]"" D
    140         . . N DIVAL S (DIVAL,DIVAL(1))=X,DIVAL(0)=1 N X S (X,X(1))=DIVAL
    141         . . N DINDEX,DIFILEI
    142         . . S DIC(0)=$TR(DIC(0),"L") D F^DIC
    143         . K DIC("S") S:$D(DIC("S1")) DIC("S")=DIC("S1") K DIC("S1")
    144         D E Q
    145         ;
    146 SOU     D SOU^DICM1 Q
     1DICM ;SFISC/GFT,XAK,TKW-MULTIPLE LOOKUP FOR FLDS WHICH MUST BE TRANSFORMED ;26JUN2006
     2 ;;22.0;VA FileMan;**4,20,31,40,149**;Mar 30, 1999;Build 2
     3 ;Per VHA Directive 10-93-142, this routine should not be modified.
     4 I '$D(DICR(1)),DIC(0)'["T" N DICR S DICR=0
     5 I $A(X)=34,X?.E1"""" G N
     6 I $G(^DD(+DO(2),0,"LOOK"))]"",^("LOOK")'="SOUNDEX" G @^("LOOK")
     7 I DIC(0)["U" S DD=0 G W
     8 I DIC(0)["T" G 2
     9R N DIFLAGS S DIFLAGS="4l"_$P("M^",U,DIC(0)["M")
     10 N DIFORCE D
     11 . S DIFORCE=0 I DIC(0)'["M"!($D(DID)) S DIFORCE=1
     12 . S DIFORCE(0)=$S(DIC(0)'["M":DINDEX,$D(DID):DID,1:"*"),DIFORCE(1)=1
     13 F  D 1 I DINDEX=""!(Y>0)!($G(DTOUT))!($G(DIROUT)) Q
     14 G 2
     15 ;
     161 N DS,%Y,DIV
     17 I $G(DINDEX("IXFILE")) S Y=DINDEX(1,"FILE"),%Y=DINDEX(1,"FIELD")
     18 E  S Y=$O(^DD(+DO(2),0,"IX",DINDEX,0)) S:Y="" Y=-1 S %Y=+$O(^(Y,0))
     19 I Y=-1,DINDEX="B" S Y=+DO(2),%Y=.01
     20 S:Y="" Y=-1 S:%Y="" %Y=-1
     21 I $D(DICR(U,Y,%Y,DINDEX)) S Y=-1
     22 E  I %Y=.01,DINDEX'="B",Y=+DO(2),$D(DICR(U,Y,%Y,"B")),$G(DINDEX(1,"TRANCODE"))="" S Y=-1
     23 I Y'<0 D
     24 . S DS=$G(^DD(Y,%Y,0)) I DS="" S Y=-1 Q
     25 . S %=DINDEX,DICR(U,Y,%Y,DINDEX)=0
     26 . I $D(^DD(Y,%Y,7)) D RS K DS X ^(7) Q
     27 . I $G(DINDEX("IXTYPE"))="S" D A,SOU^DICM1,D Q:Y>0  S Y=-1 Q
     28 . S DIX=Y,Y=$P(DS,U,2)
     29 . S Y=$S(Y["P":"P",Y["D":"D",Y["S":"S",Y["V":"V",1:"")
     30 . I Y]"" D A D:'Y ^DICM1,D Q:Y>0  S Y=-1 Q
     31 . I $G(DINDEX(1,"TRANCODE"))]"" S Y="T" D A,^DICM1 N DITRANX S DITRANX=1 D D
     32 . Q:Y>0  S Y=-1 Q
     33 Q:Y>0!(DIC(0)["T")  D
     34 . K DIV M DIV=X S DIV(1)=X N X,Y
     35 . D NXTINDX^DICF2(.DINDEX,.DIFORCE,.DIFILEI,DIFLAGS,.DIV,"*") Q
     36 Q
     37 ;
     382 D D^DIC0 S %=D
     39 G K:Y>0!($G(DIROUT))
     40 I X?.E1L.E,DIC(0)'["X" D  G K:$G(DIROUT)
     41 . D % N DIFILEI,DINDEX
     42 . S DIC(0)=$TR(DIC(0),"L"),X=$$UP^DILIBF(X) S:$G(DILONGX) DICR(DICR,"ORG")=X
     43 . D DIC Q
     44 I Y'>0,X["," S DS="",DIX=$P(X,",",1) I DIC(0)'["X",$L(DIX)<31 D  G K:$G(DIROUT)
     45 . F %=2:1 S DD=$P(X,",",%) I DD'["""" D  Q:DD=""
     46 . . F  Q:$A(DD)-32  S DD=$E(DD,2,999)
     47 . . F  Q:$A(DD,$L(DD))-32  S DD=$E(DD,1,$L(DD)-1)
     48 . . I $L(DD)*2+$L(DS)>200!(DD="") S DD="" Q
     49 . . S DS=DS_" I %?.E1P1"""_DD_""".E!(D'=""B""&(%?1"""_DD_""".E))" Q
     50 . Q:DS=""  S %=D
     51 . D % S X=DIX N DILONGX
     52 . S DS="S %=$P(^(0),U,1)"_DS,DIC(0)=DIC(0)_"D" D 7 Q
     53 I Y'>0,$L(X)>30 D
     54 . N DILONGX S DILONGX=1
     55 . S %=D D % S Y="DICR("_DICR_")",DICR(DICR,"ORG")=X
     56 . S DS=$S(DIC(0)["X":"I DIVAL="_Y,1:"I '$L($P(DIVAL,"_Y_"))")
     57 . S:DIC(0)["O"&(DIC(0)'["E") DS=DS_",'$L($P(DIVAL,"_Y_",2))"
     58 . D 7 I Y>0!(X'?.E1L.E)!(DIC(0)["X") K DILONGX Q
     59 . S %=D D % S (X,DICR(DICR,"ORG"))=$$UP^DILIBF(X)
     60 . S Y="DICR("_DICR_",""ORG"")"
     61 . S DS="I '$L($P(DIVAL,"_Y_"))" S:DIC(0)["O"&(DIC(0)'["E") DS=DS_",'$L($P(DIVAL,"_Y_",2))"
     62 . D 7 K DILONGX Q
     63 ;
     64K S DD=$D(DICR(DICR,6)) K:'DICR DICR
     65 I Y>0 K DIC("W") D R^DIC2 Q
     66 I $G(DTOUT)!($G(DIROUT)) Q
     67W I @("$O("_DIC_"""A[""))]""""") G NL:DIC(0)["N",DD
     68 I DO(2)'["Z" S Y=0 D  Q:Y>0!($G(DIROUT))
     69 . N DIOUT S DIOUT=0 F DS=1:1 S @("Y=$O("_DIC_"Y))") D  Q:DIOUT
     70 . . I 'Y S Y=-1,DIOUT=1 Q
     71 . . W:DIC(0)["E"&(DS#20=0) ".."
     72 . . I $D(@(DIC_Y_",0)")),$P(^(0),U)=X X:$D(DIC("S")) DIC("S") I  S DIOUT=1
     73 . . I DIOUT S DIY="",DS=1 N DZ,DD D ADDKEY^DIC3,GOT^DIC2
     74 . . Q
     75NL I '$G(DICR) D NQ I $T D  Q:Y>0!($G(DTOUT))!($G(DIROUT))
     76 . N:'$G(DIASKOK) DIASKOK S (DS,DIASKOK)=1 N DZ,DD
     77 . D ADDKEY^DIC3,GOT^DIC2 Q
     78DD S Y=-1 I DD D BAD^DIC1 Q
     79L I DIC(0)["L" K DD G ^DICN
     80B D BAD^DIC1 Q
     81 ;
     82N D RS S X=$E(X,2,$L(X)-1),%=D D
     83 . I DINDEX("#")>1 S %Y=+$G(DINDEX(1,"FIELD")),DS=$G(^DD(+$G(DINDEX(1,"FILE")),%Y,0)) Q:DS]""
     84 . S DS=^DD(+DO(2),.01,0),%Y=.01 Q
     85 F Y="P","D","S","V" I $P(DS,U,2)[Y K:Y="P" DO D ^DICM1 S:$D(X)#2 DS("INT")=X Q
     86 I $D(X),DINDEX("#")>1 S X(1)=X
     87 S Y=-1 D L:$D(X),E
     88 I Y'>0 K DUOUT D BAD^DIC1 Q
     89 G 2
     90 ;
     91A ; Set variables needed for transforming date/set/ptr/var.ptr
     92 S DICR(DICR+1,4)=%
     93 D % K DF,DID,DINUM Q
     94 ;
     95% ; Set variables up before doing lookup w/transformed value
     96 I DIC(0)'["L" S DICR(DICR+1,8)=1
     97 E  I '$$OKTOADD^DICM0(.DIFILEI,.DINDEX,.DIFINDER) S DICR(DICR+1,8)=1
     98 I $G(DINUM)]"" S DICR(DICR+1,10)=DINUM
     99 I $D(DF) S DICR(DICR+1,9)=DF S:$G(DID)]"" DICR(DICR+1,9.1)=$G(DID(1))_U_DID
     100RS S DICR=DICR+1,DICR(DICR)=X,DICR(DICR,0)=DIC(0),DIC(0)=$TR(DIC(0),"A"),DIC(0)=$TR(DIC(0),"Q") Q
     101 ;
     102D S:$G(DICR(DICR,10))]"" DINUM=DICR(DICR,10)
     103 S (D,DF)=DICR(DICR,4) D
     104 . N T S T=$P($G(DS),U,2)
     105 . S DIC(0)=$TR(DIC(0),"M","") I T["V" S DIC(0)=$TR(DIC(0),"A","")
     106 . I D="B",T'["D",'$G(DITRANX) S DIC(0)=DIC(0)_"s"
     107 . I T["P"!(T["V")!(T["S") S DIC(0)=DIC(0)_"X"
     108 . Q
     109 I DICR(DICR,4)=DINDEX N I M I=DINDEX N DINDEX M DINDEX=I K I S DINDEX("START")=DINDEX
     110 E  N DINDEX D
     111 . S (DINDEX,DINDEX("START"))=DICR(DICR,4),DINDEX("WAY")=1
     112 . D INDEX^DICUIX(.DIFILEI,DIFLAGS,.DINDEX,"",.DIVALUE) Q
     113 I DINDEX("#")>1 S (DINDEX(1),DINDEX(1,"FROM"),DINDEX(1,"PART"))=$G(X)
     114RCR S:'$D(DIDA) DICRS=1
     115DIC ;
     116 I $D(DICR(DICR,8)) S DIC(0)=$TR(DIC(0),"L")
     117 S Y=-1 I $D(X),$L(X)<31 D
     118 . N DIVAL S (DIVAL,DIVAL(1))=X N X S (X,X(1))=DIVAL
     119 . D RENUM^DIC1 K DIDA Q
     120 S:DIC(0)["L" DICR(DICR-1,6)=1 K:$D(DICR(DICR,4)) DF
     121E S D="B",%=DICR,X=DICR(%),DIC(0)=DICR(%,0),DICR=%-1
     122 S:$G(DICR(%,10))]"" DINUM=DICR(%,10)
     123 S:$D(DICR(%,9)) (D,DF)=DICR(%,9) I $G(DICR(%,9.1))]"" S:$P(DICR(%,9.1),U)]"" DID(1)=$P(DICR(%,9.1),U) S DID=$P(DICR(%,9.1),U,2,999)
     124 K DICRS,DICR(%) D DO^DIC1:'$D(DO) Q
     125 ;
     126NQ I $L(X)<14,X?.NP,+X=X,@("$D("_DIC_"X,0))") S Y=X D S^DIC3
     127 Q
     128 ;
     129SOUNDEX I DIC(0)["E",'$D(DICRS) W "  " D RS,SOU S DIC(0)=$TR(DIC(0),"L") D RCR Q:Y>0
     130 G R
     131 ;
     1327 S Y=-1 N % S %=$S($D(DIC("S")):DIC("S"),1:1)
     133 I $D(DS),'$D(DIC("S1")) D
     134 . S DIC("S")=DS I '% S DIC("S")=DIC("S")_" X DIC(""S1"")",DIC("S1")=%
     135 . I X]"" D
     136 . . N DIVAL S (DIVAL,DIVAL(1))=X,DIVAL(0)=1 N X S (X,X(1))=DIVAL
     137 . . N DINDEX,DIFILEI
     138 . . S DIC(0)=$TR(DIC(0),"L") D F^DIC
     139 . K DIC("S") S:$D(DIC("S1")) DIC("S")=DIC("S1") K DIC("S1")
     140 D E Q
     141 ;
     142SOU D SOU^DICM1 Q
Note: See TracChangeset for help on using the changeset viewer.