| [613] | 1 | MCARDCN ;WISC/TJK-MODIFIED DICN ROUTINE FOR MEDICINE SCREENS ;7/24/96 07:35
|
|---|
| 2 | ;;2.3;Medicine;;09/13/1996
|
|---|
| 3 | S DO(1)=1
|
|---|
| 4 | I $S($D(DLAYGO):DO(2)\1-(DLAYGO\1),1:1),DUZ(0)'="@",$D(^DIC(+DO(2),0,"LAYGO")) F MCPCT=1:1 I DUZ(0)[$E(^("LAYGO"),MCPCT) G B:MCPCT>$L(^("LAYGO")) Q
|
|---|
| 5 | I $D(DD) S X=DD D N^MCARDCN1 G I:$D(X),B
|
|---|
| 6 | D DS S DIX=X I X?.NP,X,DIC(0)["E",'$D(DICR),DS'["DINUM",$P(DS,U,2)'["N",DIC(0)["N"!$D(^DD(+DO(2),.001,0)) D N^MCARDCN1 I $D(X) S DD=X G I
|
|---|
| 7 | S X=DIX D VAL G I:$D(X)
|
|---|
| 8 | S X=DIX
|
|---|
| 9 | B K Y(0) G BAD^MCARDC1
|
|---|
| 10 | ;
|
|---|
| 11 | 1 I '$D(DIC("S")) W " (THE ",Y,$S(Y#10=1&(Y#100-11):"ST",Y#10=2&(Y#100-12):"ND",Y#10=3&(Y#100-13):"RD",1:"TH"),$S('$D(^DD(+DO(2),0,"UP")):"",1:" FOR THIS "_$O(^DD(^("UP"),0,"NM",0))),")"
|
|---|
| 12 | YN ;
|
|---|
| 13 | W "? ",$P("YES// ^NO// ",U,MCPCT)
|
|---|
| 14 | RX R MCPCTY:DTIME E S DTOUT=1,MCPCTY=U W *7
|
|---|
| 15 | S:MCPCTY]""!'MCPCT MCPCT=$A(MCPCTY),MCPCT=$S(MCPCT=89:1,MCPCT=121:1,MCPCT=78:2,MCPCT=110:2,MCPCT=94:-1,1:0)
|
|---|
| 16 | I 'MCPCT,MCPCTY'?."?" W *7,"??",!?4,"ANSWER 'YES' OR 'NO': " G RX
|
|---|
| 17 | W:$X>73 ! W $P(" (YES)^ (NO)",U,MCPCT) Q
|
|---|
| 18 | ;
|
|---|
| 19 | DS S DS=^DD(+DO(2),.01,0) Q
|
|---|
| 20 | ;
|
|---|
| 21 | VAL I X'?.ANP!($A(X)=45) K X Q
|
|---|
| 22 | I $P(DS,U,2)["*" S:DS["DINUM" DINUM=X Q
|
|---|
| 23 | S MCPCT=$F(DS,"%DT=""E"),DS=$E(DS,1,MCPCT-2)_$E(DS,MCPCT,999) X $P(DS,U,5,99) Q
|
|---|
| 24 | ;
|
|---|
| 25 | ;; ***ORIGINAL*** ;; I I DIC(0)["E",DO(2)'["A" S DJC=+DO(2),Y=X D Y^MCARDCM2 K DJC X:$Y>20 DJCP W *7,!?3,"ARE YOU ADDING " W:'$D(DD) "'"_Y_"' AS " S MCPCT=$P(DO,U,1) W !?7 W "A NEW "_MCPCT S MCPCT=0,Y=$P(DO,U,4)+1 D 1 G B:MCPCT-1
|
|---|
| 26 | I I DIC(0)["E",DO(2)'["A" S DJC=+DO(2),Y=X D Y^MCARDCM2 K DJC X DJCP W *7,!?3,"ARE YOU ADDING " W:'$D(DD) "'"_Y_"' AS " S MCPCT=$P(DO,U,1) W !?7 W "A NEW "_MCPCT S MCPCT=0,Y=$P(DO,U,4)+1 D 1 G B:MCPCT-1
|
|---|
| 27 | G FILE:'$D(DD)
|
|---|
| 28 | R D DS W !?3,$P(DS,U,1),": " R X:DTIME S:'$T X=U
|
|---|
| 29 | G B:X[U,R:X="" D VAL I '$D(X) W *7,"??" W:$D(^DD(+DO(2),.01,3)) !,^(3) G R
|
|---|
| 30 | FILE D:'$D(DO) DO^MCARDC1 F DIX=0:0 S DIX=$O(^DD(+DO(2),.01,"LAYGO",DIX)) Q:DIX'>0 I $D(^(DIX,0)) X ^(0) I '$T S Y=-1 G A^MCARDC:$D(DO(1)),Q^MCARDC
|
|---|
| 31 | S DIX=X
|
|---|
| 32 | F1 S X=$P(DO,U,3) D INCR S X=X\DIY*DIY+DIY
|
|---|
| 33 | I $D(DINUM) S X=DINUM D INCR
|
|---|
| 34 | F2 I $D(@(DIC_"X)")) S X=X\DIY*DIY+DIY G B:$D(DINUM),F2
|
|---|
| 35 | S Y=$P(DO,"^",2) I $D(DD) S X=DD
|
|---|
| 36 | E I 'Y,DUZ(0)'="@" G LOCK
|
|---|
| 37 | I DIC(0)["E",$D(^DD(+Y,.001,0)) G NUM^MCARDCN1
|
|---|
| 38 | LOCK L @(DIC_"X):1") I $D(@(DIC_"X)"))!'$T L W *7 G F1
|
|---|
| 39 | ; Nake Reference in LOCK+3 is refs in Line tag LOCK
|
|---|
| 40 | ; DIC is set to ^MCAR(xxx, where xxx is a file number.
|
|---|
| 41 | S ^(X,0)=DIX,DD=0 L K D S:$D(DA)#2 D=DA S DA=X,X=DIX
|
|---|
| 42 | I $D(@(DIC_"0)")) S ^(0)=$P(^(0),"^",1,2)_"^"_DA_"^"_($P(^(0),"^",4)+1)
|
|---|
| 43 | IX S DS=X,DD=$O(^DD(+DO(2),.01,1,DD)) S:DD="" DD=-1 I DD>0 G RIX^MCARDCN1:^(DD,0)["TRIGGER"!(^(0)["BULL") X ^(1) S X=DS G IX
|
|---|
| 44 | I DIC(0)["E"&($O(^DD(+DO(2),0,"ID",0))>0)!$D(DIC("DR")) G ^MCARDCN1
|
|---|
| 45 | D ;
|
|---|
| 46 | S Y=DA_"^"_X_"^"_1 S:$D(D)#2 DA=D G R^MCARDC
|
|---|
| 47 | ;
|
|---|
| 48 | INCR S DIY=1 I $P(DO,U,2)>1 F MCPCT=1:1:$L($P(X,".",2)) S DIY=DIY/10
|
|---|
| 49 | Q
|
|---|
