| 1 | LAKDIFF2 ;DALOI/RWF/LL/RES - RBC MORPHOLOGY ; 7/14/87 08:01
|
|---|
| 2 | ;;5.2;AUTOMATED LAB INSTRUMENTS;**52**;Sep 27, 1994
|
|---|
| 3 | ;
|
|---|
| 4 | A ;
|
|---|
| 5 | K KEY,NC,TY,T1,T2
|
|---|
| 6 | S KEY=""
|
|---|
| 7 | ;
|
|---|
| 8 | S I=0
|
|---|
| 9 | F S I=$O(^TMP($J,"R",I)) Q:I="" S X=^(I),KEY(X)=I,KEY=KEY_X
|
|---|
| 10 | ;
|
|---|
| 11 | S T1=1,(T1(T1),T2(T1))=""
|
|---|
| 12 | F I=31:1:58 D Q:$O(^TMP("LA",$J,I))=""
|
|---|
| 13 | . S T2=I
|
|---|
| 14 | . S X=$G(^TMP("LA",$J,I,4))
|
|---|
| 15 | . S Y=$G(^TMP("LA",$J,I,.1))
|
|---|
| 16 | . S T1(T1)=T1(T1)_$J(X,8)
|
|---|
| 17 | . S T2(T1)=T2(T1)_$J(Y,8)
|
|---|
| 18 | . Q:$O(^TMP("LA",$J,I))=""
|
|---|
| 19 | . I '(I-30#9) S T1=T1+1,(T1(T1),T2(T1))=""
|
|---|
| 20 | ;
|
|---|
| 21 | S (DONE,FLAG)=0
|
|---|
| 22 | D HD1^LAKDIFF1,HD2
|
|---|
| 23 | ;
|
|---|
| 24 | F Q:FLAG!DONE D
|
|---|
| 25 | . N DTOUT
|
|---|
| 26 | . D SAY^XGF(IOSL-1,0,"RBC: ")
|
|---|
| 27 | . S TYPE=$$READ^XGF(1,DTIME)
|
|---|
| 28 | . I TYPE="^"!($D(DTOUT)) S FLAG=1
|
|---|
| 29 | . S LINE=$S(TYPE="":"STOP",TYPE="!":"COM",TYPE="\":"WBC",KEY'[TYPE:"HELP",1:"RESULT")
|
|---|
| 30 | . D @LINE
|
|---|
| 31 | ;
|
|---|
| 32 | I DONE D STORE
|
|---|
| 33 | K X,A,DATYP,X,CODE,TYPE,CONT,DONE,J,K
|
|---|
| 34 | Q
|
|---|
| 35 | ;
|
|---|
| 36 | RESULT ;
|
|---|
| 37 | ;
|
|---|
| 38 | N DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y
|
|---|
| 39 | ;
|
|---|
| 40 | S DIR(0)="63.04,"_^TMP("LA",$J,KEY(TYPE),.2)
|
|---|
| 41 | S DIR("A")=$P(^LAB(60,^TMP("LA",$J,KEY(TYPE),0),0),U,1)
|
|---|
| 42 | S DIR("B")=$G(TY(TYPE))
|
|---|
| 43 | D ^DIR
|
|---|
| 44 | I $D(DIRUT) D
|
|---|
| 45 | . I X="",Y="" Q
|
|---|
| 46 | . I X="@",$D(TY(TYPE)) K TY(TYPE) Q
|
|---|
| 47 | . S FLAG=1
|
|---|
| 48 | I $L(Y) S TY(TYPE)=$P(Y,"^")
|
|---|
| 49 | ;
|
|---|
| 50 | D HD1^LAKDIFF1,HD2
|
|---|
| 51 | Q
|
|---|
| 52 | ;
|
|---|
| 53 | HELP ;
|
|---|
| 54 | I TYPE'="?" D Q
|
|---|
| 55 | . D SAY^XGF(IOSL-1,0,$C(7)_"INVALID RBC CELL KEY")
|
|---|
| 56 | . H 2
|
|---|
| 57 | . D CLEAR^XGF(IOSL-1,0,IOSL-1,IOM-1)
|
|---|
| 58 | ;
|
|---|
| 59 | ;
|
|---|
| 60 | ; Display current morphology results
|
|---|
| 61 | S $Y=LRDY
|
|---|
| 62 | F I1=1:9:T2-30 D
|
|---|
| 63 | . S $Y=$Y+4,$X=6
|
|---|
| 64 | . F I=I1:1:I1+8 Q:I+30>T2 D
|
|---|
| 65 | . . S X=$G(^TMP($J,"R",I+30),"^"),K=$G(TY(X))
|
|---|
| 66 | . . I '$L(K) S $X=$X+8
|
|---|
| 67 | . . E D SAY^XGF($Y,$X+(9-$L(K)),K,"R1")
|
|---|
| 68 | ;
|
|---|
| 69 | D CLEAR^XGF(IOSL-1,0,IOSL-1,IOM-1)
|
|---|
| 70 | Q
|
|---|
| 71 | ;
|
|---|
| 72 | WBC ;
|
|---|
| 73 | N DIR,DIROUT,DIRUT,DTOUT,DUOUT,K,X,Y
|
|---|
| 74 | ;
|
|---|
| 75 | D HD1^LAKDIFF1
|
|---|
| 76 | ;
|
|---|
| 77 | W !!,?30,"> CELL DIFFERENTIAL <",!
|
|---|
| 78 | S K=0
|
|---|
| 79 | F S K=$O(^TMP($J,"W",K)) Q:K'>0 D
|
|---|
| 80 | . S X=^TMP("LA",$J,K,1)
|
|---|
| 81 | . I $D(@X) W !,?3,$$LJ^XLFSTR(^TMP("LA",$J,K,.1),8,".")," ",$J(@X,3)
|
|---|
| 82 | ;
|
|---|
| 83 | S DIR(0)="E" D ^DIR
|
|---|
| 84 | D HD1^LAKDIFF1,HD2
|
|---|
| 85 | Q
|
|---|
| 86 | ;
|
|---|
| 87 | STOP ;
|
|---|
| 88 | N DIR,DIRUT,DIROUT,DTOUT,DUOUT,X,Y
|
|---|
| 89 | ;
|
|---|
| 90 | D EVAL
|
|---|
| 91 | ;
|
|---|
| 92 | W !
|
|---|
| 93 | S DIR(0)="YO",DIR("A")="Are you finished with this patient",DIR("B")="Y"
|
|---|
| 94 | D ^DIR
|
|---|
| 95 | I $D(DIRUT) S FLAG=1 Q
|
|---|
| 96 | I Y=1 S DONE=1
|
|---|
| 97 | I FLAG=DONE D HD1^LAKDIFF1,HD2
|
|---|
| 98 | Q
|
|---|
| 99 | ;
|
|---|
| 100 | EVAL ;
|
|---|
| 101 | D HD1^LAKDIFF1
|
|---|
| 102 | W !
|
|---|
| 103 | S X=""
|
|---|
| 104 | F I=0:0 S I=$O(^TMP($J,"R",I)) Q:I="" D
|
|---|
| 105 | . S Y=^(I)
|
|---|
| 106 | . I $D(TY(Y)) D
|
|---|
| 107 | . . W !?2,$J(^TMP("LA",$J,I,.1),8),": ",?12
|
|---|
| 108 | . . S V=TY(Y)
|
|---|
| 109 | . . X ^TMP("LA",$J,I,2)
|
|---|
| 110 | . . W $J(V,3)
|
|---|
| 111 | Q
|
|---|
| 112 | ;
|
|---|
| 113 | STORE ;
|
|---|
| 114 | ;
|
|---|
| 115 | N I,X,Y
|
|---|
| 116 | ;
|
|---|
| 117 | S X="",I=0
|
|---|
| 118 | F S I=$O(^TMP($J,"R",I)) Q:I="" D
|
|---|
| 119 | . S Y=^(I)
|
|---|
| 120 | . I '$D(TY(Y)) Q
|
|---|
| 121 | . S V=TY(Y)
|
|---|
| 122 | . X ^TMP("LA",$J,I,2)
|
|---|
| 123 | . S @^TMP("LA",$J,I,1)=V
|
|---|
| 124 | Q
|
|---|
| 125 | ;
|
|---|
| 126 | HD2 ;
|
|---|
| 127 | ; Display morphology headers
|
|---|
| 128 | ;
|
|---|
| 129 | S LRDY=$Y+2
|
|---|
| 130 | D SAY^XGF(LRDY,4,"RBC MORPHOLOGY ('?' = DISPLAY, '!' = COMMENTS, '\' = WBC, <RETURN> = EXIT)")
|
|---|
| 131 | S $Y=$Y+1
|
|---|
| 132 | F I=1:1:T1 D
|
|---|
| 133 | . D SAY^XGF("+",0,$$LJ^XLFSTR("KEY",7)_T1(I))
|
|---|
| 134 | . D SAY^XGF("+",0,$$LJ^XLFSTR("TEST",7)_T2(I))
|
|---|
| 135 | . S $Y=$Y+2
|
|---|
| 136 | ;
|
|---|
| 137 | HD3 ;
|
|---|
| 138 | I LAUPDATE=0 Q
|
|---|
| 139 | S TYPE="?"
|
|---|
| 140 | D HELP
|
|---|
| 141 | Q
|
|---|
| 142 | ;
|
|---|
| 143 | COM ;
|
|---|
| 144 | D COM1^LAKDIFF1,HD1^LAKDIFF1,HD2
|
|---|
| 145 | Q
|
|---|
