| 1 | MCARDCM ;WISC/TJK-MODIFIED DICM ROUTINE FOR MEDICINE SCREENS ;7/19/96 15:18
|
|---|
| 2 | ;;2.3;Medicine;;09/13/1996
|
|---|
| 3 | S:'$D(DICR(1)) DICR=0 I $A(X)=34,X?.E1"""" G N
|
|---|
| 4 | G:$D(^DD(+DO(2),0,"LOOK")) @^("LOOK") I DIC(0)["U" S DD=0 G W
|
|---|
| 5 | R S MCPCT="B",Y=+DO(2),MCPCTY=.01,DD=0 G 1
|
|---|
| 6 | Z S MCPCT=$O(^DD(+DO(2),0,"IX",MCPCT)) S:MCPCT="" MCPCT=-1 S Y=$O(^(MCPCT,0)) S:Y="" Y=-1 S MCPCTY=$O(^(Y,0)) S:MCPCTY="" MCPCTY=-1 S DD=1
|
|---|
| 7 | 1 G 2:Y<0,Z:$D(DICR(U,Y,MCPCTY)),Z:D'=MCPCT&(DIC(0)'["M"),Z:'$D(^DD(Y,MCPCTY,0)) S DICR(U,Y,MCPCTY)=0,DS=^(0) I $D(^(7)) D RS K DS X ^(7) G Y
|
|---|
| 8 | S DIX=Y F Y="P","D","S","V",-1 I $P(DS,U,2)[Y D A D:'Y ^MCARDCM1,D Q
|
|---|
| 9 | Y G R:Y<0
|
|---|
| 10 | 2 G K:Y+1 I X?.E1L.E,DIC(0)'["X" D RS D LC^MCARDCM1 G K:Y+1
|
|---|
| 11 | S DS="",DIX=$P(X,",",1) F MCPCT=2:1 S DD=$P(X,",",MCPCT) I DD'["""" S:$A(DD)=32 DD=$E(DD,2,999) Q:$L(DD)*2+$L(DS)>200!(DD="") S DS=DS_" I MCPCT?.E1P1"""_DD_""".E!(D'=""B""&(MCPCT?1"""_DD_""".E))"
|
|---|
| 12 | ; Naked References in 2+3 is refs by line tag 1
|
|---|
| 13 | I DS]"",DIC(0)'["X" D RS S X=DIX,DS="S MCPCT=$P(^(0),U,1)"_DS,DIC(0)=DIC(0)_"D" D 7 G K:Y+1
|
|---|
| 14 | I $L(X)>30 D RS S Y="DICR("_DICR_")",DS=$S(DIC(0)["X":"I $P(^(0),U,1)="_Y,1:"I '$L($P(^(0),"_Y_",1))"),X=$E(X,1,30) D 7
|
|---|
| 15 | K S DD=$D(DICR(DICR,6)) K:'DICR DICR
|
|---|
| 16 | I Y+1 K DIC("W") G R^MCARDC:DIC(0)["Z",Q^MCARDC
|
|---|
| 17 | W D U G:'$T NL:DIC(0)["N",DD I DO(2)'["Z" S Y=0 F DS=1:1 S @("Y=$O("_DIC_"Y))") S:Y="" Y=-1 Q:Y'>0 W:DIC(0)["E"&(DS#20=0) ".." I $P(^(Y,0),U,1)=X X:$D(DIC("S")) DIC("S") I S DIY="" G GOT^MCARDC
|
|---|
| 18 | NL I '$D(DICR) D NQ G GOT^MCARDC:$T
|
|---|
| 19 | DD G B:DD
|
|---|
| 20 | L I DIC(0)["L" K DD G ^MCARDCN
|
|---|
| 21 | B G O^MCARDC1
|
|---|
| 22 | ;
|
|---|
| 23 | N D RS S X=$E(X,2,$L(X)-1),DS=^DD(+DO(2),.01,0),MCPCT=D F Y="P","D","S","V" I $P(DS,U,2)[Y K:Y="P" DO D ^MCARDCM1 Q
|
|---|
| 24 | S Y=-1 D L:$D(X),E G B:Y<0,2
|
|---|
| 25 | ;
|
|---|
| 26 | A G MCPCT:'DD I '$D(^DD(DIX,MCPCTY,1,DD)) S DD=$O(^(DD)) S:DD="" DD=-1 G A:DD>0 S Y=-1 Q
|
|---|
| 27 | ; Naked ref in next line is to ^DD(DIX,MCPCTY,1, in previous line
|
|---|
| 28 | I $S($D(^(DD,0)):$P(^(0),U,3,9)]"",1:1) S DD=DD+1 G A
|
|---|
| 29 | MCPCT S DICR(DICR+1,4)=MCPCT I MCPCT'="B"!(DIC(0)'["L") S DICR(DICR+1,8)=1
|
|---|
| 30 | I $D(DF) S DICR(DICR+1,9)=DF K DF
|
|---|
| 31 | RS S DICR=DICR+1,DICR(DICR)=X,DICR(DICR,0)=DIC(0),DD="A" D DZ S DD="Q"
|
|---|
| 32 | DZ S DIC(0)=$P(DIC(0),DD,1)_$P(DIC(0),DD,2) Q
|
|---|
| 33 | ;
|
|---|
| 34 | D S (D,DF)=DICR(DICR,4),DD="M" S:D="B" DIC(0)=DIC(0)_"S" D DZ I $D(DS),$P(DS,U,2)["V" S DD="A" D DZ
|
|---|
| 35 | RCR S DICRS=1
|
|---|
| 36 | DIC ;
|
|---|
| 37 | I $D(DICR(DICR,8)) S DD="L" D DZ
|
|---|
| 38 | S Y=-1 I $D(X),$L(X)<31 D RENUM^MCARDC1
|
|---|
| 39 | S:DIC(0)["L" DICR(DICR-1,6)=1 K:$D(DICR(DICR,4)) DF
|
|---|
| 40 | E S D="B",MCPCT=DICR,X=DICR(MCPCT),DIC(0)=DICR(MCPCT,0),DICR=MCPCT-1 S:$D(DICR(MCPCT,9)) (D,DF)=DICR(MCPCT,9) K DICRS,DICR(MCPCT) D DO^MCARDC1:'$D(DO) Q
|
|---|
| 41 | ;
|
|---|
| 42 | U I @("$O("_DIC_"""A[""))=""""")
|
|---|
| 43 | Q
|
|---|
| 44 | ;
|
|---|
| 45 | NQ I $L(X)<14,X?.NP,+X=X,@("$D("_DIC_"X,0))") S Y=X D S^MCARDC
|
|---|
| 46 | Q
|
|---|
| 47 | ;
|
|---|
| 48 | SOUNDEX I DIC(0)["E",'$D(DICRS) W " " D RS,SOU S DD="L" D DZ,RCR Q:Y>0
|
|---|
| 49 | G R
|
|---|
| 50 | ;
|
|---|
| 51 | 7 S Y=-1,MCPCT=$S($D(DIC("S")):DIC("S"),1:1) I $D(DS),'$D(DIC("S1")) S DIC("S")=DS,DD="L" S:'MCPCT DIC("S")=DIC("S")_" X DIC(""S1"")",DIC("S1")=MCPCT D:X]"" DZ,F^MCARDC K DIC("S") S:$D(DIC("S1")) DIC("S")=DIC("S1") K DIC("S1")
|
|---|
| 52 | G E
|
|---|
| 53 | ;
|
|---|
| 54 | SOU G SOU^MCARDCM1
|
|---|
