LRKDIFF1 ;SLC/RWF,LL/RES- KEYBOARD DIFF PART 2 ; 7/14/87 08:02 ; [ 10/14/90 8:56 PM ]
;;V~5.0~;LAB;;02/27/90 17:09
;WBC DIFF CELL COUNTER
A K KEY,NC,TY,T1,T2 S KEY="" F I=0:0 S I=$O(^UTILITY($J,"W",I)) Q:I="" S K=^(I),KEY(K)=I,KEY=KEY_K,TY(K)="" S:$D(^UTILITY($J,"NC",I)) NC(K)=""
F I=1:1:27 S X=$S($D(^UTILITY("LA",$J,I,4)):^(4),1:""),Y=$S($D(^UTILITY("LA",$J,I,.1)):^(.1),1:""),^UTILITY($J,"A",I\9+1,I#9)=X_"^"_Y,T2=I Q:$O(^UTILITY($J,"W",I))=""
S T1=1,(T1(1),T2(1))="" F I=1:1:T2 S X=^UTILITY($J,"A",I\9+1,I#9),T1(T1)=T1(T1)_$J($P(X,U,1),8),T2(T1)=T2(T1)_$J($P(X,U,2),8) I '(I#9) S T1=T1+1,(T1(T1),T2(T1))=""
S (TOTAL,FLAG,STORE)=0,A=-1 D HD1,HD4,HD2
F J=0:0 Q:TOTAL=200!FLAG!STORE S DX=0,DY=21 X XY W !,"WBC: " R TYPE#1:DTIME D CHECK
D STORE:(TOTAL=200)!(STORE)
K TEMP,T1,T2,KEY,NC,A,CONT,J,L,TOTAL,CHK,STORE Q
CHECK I '$T!(TYPE=U) S FLAG=1 Q
S LINE=$S(TYPE="":"STOP",TYPE="-":"MINUS",TYPE="!":"COM",KEY'[TYPE:"HELP",1:"COUNT") D @LINE Q
COUNT I '$D(NC(TYPE)) S TOTAL=TOTAL+1,DX=25,DY=22 X XY W $J(TOTAL,3)
S TY(TYPE)=TY(TYPE)+1 D:TOTAL=100!(TOTAL=200) EVAL Q
HELP I TYPE'="?" W *7 Q
S DX=0,DY=LRDY X XY F I1=1:9:T2 W !!!!,?7 F I=I1:1:I1+8 Q:I>T2 S X=$S($D(^UTILITY($J,"W",I)):^(I),1:"^") S K=$S($D(TY(X)):TY(X),1:"") W $J(K,8)
Q
STOP D EVAL W:TOTAL<100 *7 W !!!,"* YOU HAVE COUNTED ",TOTAL," CELLS *"
DONE R !,"ARE YOU FINISHED WITH THE WBC CELL COUNT: (Y/N) Y//",X:DTIME I '$T S FLAG=1 Q
S:X="" X="Y" I "YyNn^"'[X W *7," ??" G DONE
S:TOTAL=0 X=U S:"Yy"[X STORE=1 S:U[X FLAG=1 D:FLAG=STORE HD1,HD2 Q
Q
EVAL W *7 D HD1
I TOTAL<100 W *7,!,"NOTE: ONLY ",TOTAL," CELLS COUNTED",!! Q:TOTAL=0
W !,"TEST",?12,"Count Value" F I=0:0 S I=$O(^UTILITY($J,"W",I)) Q:I="" S K=^(I) W !?2,^UTILITY("LA",$J,I,.1),": ",?12 S V=TY(K) W $J(V,3)," " X ^UTILITY("LA",$J,I,2) W $J(V,3)
W !,"TOTAL: ",TOTAL,! Q:'(TOTAL=100!(TOTAL=200)) D TWO:TOTAL=100 Q:'STORE
Q
TWO F I=0:0 R X#1:1 Q:'$T W *7 ;Flush buffer
W *7,!!!,"100 CELLS COUNTED, CONTINUE COUNTING TO 200 OR STOP (C/S) S//" R X:DTIME S:'$T!(X="^") FLAG=1 Q:FLAG S:X="" X="S" I "SsCc"'[X W *7," ??" G TWO
S:"Ss"[X STORE=1 Q
STORE F I=0:0 S I=$O(^UTILITY($J,"W",I)) Q:I="" S K=^(I),V=TY(K) X ^UTILITY("LA",$J,I,2) S @^UTILITY("LA",$J,I,1)=V
Q
MINUS S DX=0,DY=21 X XY R !,"SUBTRACT WHICH CELL TYPE: ",TYPE#1:DTIME I '$T S FLAG=1 Q
G MI2:TYPE="" I U[TYPE S FLAG=1 Q
I KEY'[TYPE W *7," ??" G MINUS
I TY(TYPE)>0 S TY(TYPE)=TY(TYPE)-1 I '$D(NC(TYPE)),TOTAL>0 S TOTAL=TOTAL-1
MI2 D HD3 Q
HD1 W @IOF,!!,"Patient name: ",PNM,?45,"HRCN: ",HRCN Q ;IHS/ANMC/CLS 1O/14/90 HRCN
HD2 S LRDY=$Y,DX=0,DY=$Y X XY W !,?3,"WBC MORPHOLOGY ('?' = DISPLAY, '!' = COMMENTS, '-' = MINUS, <RETURN> = EXIT)" F I=1:1:T1 W !,"KEY",?7,T1(I),!,"TEST",?7,T2(I),!!
HD3 S DX=0,DY=21 X XY W !,?18,"TOTAL:",$J(TOTAL,3)," " Q
HD4 W !!,?34,"> CBC PROFILE <",!
S I=1 F C=1:0 S C=$O(^LR(LRDFN,"CH",LRDAT,C)) Q:C'>0 S V=^(C),X=$O(^LAB(60,"C","CH;"_C_";1",0)) I X>0 W $P(^LAB(60,X,0),U,1),": ",$P(V,U,1)_" "_$P(V,U,2),?(I*25) S I=I+1 I I>3 W ! S I=1
Q
COM W !,"Comment: ",RMK,! I RMK="" R RMK:DTIME G COM2
S Y=RMK D RW^LRDIED S RMK=$S(X="@":"",1:Y)
COM2 D HD1,HD4,HD2 Q
LRKDIFF1 ;SLC/RWF,LL/RES- KEYBOARD DIFF PART 2 ; 7/14/87 08:02 ; [ 10/14/90 8:56 PM ]
+1 ;;V~5.0~;LAB;;02/27/90 17:09
+2 ;WBC DIFF CELL COUNTER
A KILL KEY,NC,TY,T1,T2
SET KEY=""
FOR I=0:0
SET I=$ORDER(^UTILITY($JOB,"W",I))
IF I=""
QUIT
SET K=^(I)
SET KEY(K)=I
SET KEY=KEY_K
SET TY(K)=""
IF $DATA(^UTILITY($JOB,"NC",I))
SET NC(K)=""
+1 FOR I=1:1:27
SET X=$SELECT($DATA(^UTILITY("LA",$JOB,I,4)):^(4),1:"")
SET Y=$SELECT($DATA(^UTILITY("LA",$JOB,I,.1)):^(.1),1:"")
SET ^UTILITY($JOB,"A",I\9+1,I#9)=X_"^"_Y
SET T2=I
IF $ORDER(^UTILITY($JOB,"W",I))=""
QUIT
+2 SET T1=1
SET (T1(1),T2(1))=""
FOR I=1:1:T2
SET X=^UTILITY($JOB,"A",I\9+1,I#9)
SET T1(T1)=T1(T1)_$JUSTIFY($PIECE(X,U,1),8)
SET T2(T1)=T2(T1)_$JUSTIFY($PIECE(X,U,2),8)
IF '(I#9)
SET T1=T1+1
SET (T1(T1),T2(T1))=""
+3 SET (TOTAL,FLAG,STORE)=0
SET A=-1
DO HD1
DO HD4
DO HD2
+4 FOR J=0:0
IF TOTAL=200!FLAG!STORE
QUIT
SET DX=0
SET DY=21
XECUTE XY
WRITE !,"WBC: "
READ TYPE#1:DTIME
DO CHECK
+5 IF (TOTAL=200)!(STORE)
DO STORE
+6 KILL TEMP,T1,T2,KEY,NC,A,CONT,J,L,TOTAL,CHK,STORE
QUIT
CHECK IF '$TEST!(TYPE=U)
SET FLAG=1
QUIT
+1 SET LINE=$SELECT(TYPE="":"STOP",TYPE="-":"MINUS",TYPE="!":"COM",KEY'[TYPE:"HELP",1:"COUNT")
DO @LINE
QUIT
COUNT IF '$DATA(NC(TYPE))
SET TOTAL=TOTAL+1
SET DX=25
SET DY=22
XECUTE XY
WRITE $JUSTIFY(TOTAL,3)
+1 SET TY(TYPE)=TY(TYPE)+1
IF TOTAL=100!(TOTAL=200)
DO EVAL
QUIT
HELP IF TYPE'="?"
WRITE *7
QUIT
+1 SET DX=0
SET DY=LRDY
XECUTE XY
FOR I1=1:9:T2
WRITE !!!!,?7
FOR I=I1:1:I1+8
IF I>T2
QUIT
SET X=$SELECT($DATA(^UTILITY($JOB,"W",I)):^(I),1:"^")
SET K=$SELECT($DATA(TY(X)):TY(X),1:"")
WRITE $JUSTIFY(K,8)
+2 QUIT
STOP DO EVAL
IF TOTAL<100
WRITE *7
WRITE !!!,"* YOU HAVE COUNTED ",TOTAL," CELLS *"
DONE READ !,"ARE YOU FINISHED WITH THE WBC CELL COUNT: (Y/N) Y//",X:DTIME
IF '$TEST
SET FLAG=1
QUIT
+1 IF X=""
SET X="Y"
IF "YyNn^"'[X
WRITE *7," ??"
GOTO DONE
+2 IF TOTAL=0
SET X=U
IF "Yy"[X
SET STORE=1
IF U[X
SET FLAG=1
IF FLAG=STORE
DO HD1
DO HD2
QUIT
+3 QUIT
EVAL WRITE *7
DO HD1
+1 IF TOTAL<100
WRITE *7,!,"NOTE: ONLY ",TOTAL," CELLS COUNTED",!!
IF TOTAL=0
QUIT
+2 WRITE !,"TEST",?12,"Count Value"
FOR I=0:0
SET I=$ORDER(^UTILITY($JOB,"W",I))
IF I=""
QUIT
SET K=^(I)
WRITE !?2,^UTILITY("LA",$JOB,I,.1),": ",?12
SET V=TY(K)
WRITE $JUSTIFY(V,3)," "
XECUTE ^UTILITY("LA",$JOB,I,2)
WRITE $JUSTIFY(V,3)
+3 WRITE !,"TOTAL: ",TOTAL,!
IF '(TOTAL=100!(TOTAL=200))
QUIT
IF TOTAL=100
DO TWO
IF 'STORE
QUIT
+4 QUIT
TWO ;Flush buffer
FOR I=0:0
READ X#1:1
IF '$TEST
QUIT
WRITE *7
+1 WRITE *7,!!!,"100 CELLS COUNTED, CONTINUE COUNTING TO 200 OR STOP (C/S) S//"
READ X:DTIME
IF '$TEST!(X="^")
SET FLAG=1
IF FLAG
QUIT
IF X=""
SET X="S"
IF "SsCc"'[X
WRITE *7," ??"
GOTO TWO
+2 IF "Ss"[X
SET STORE=1
QUIT
STORE FOR I=0:0
SET I=$ORDER(^UTILITY($JOB,"W",I))
IF I=""
QUIT
SET K=^(I)
SET V=TY(K)
XECUTE ^UTILITY("LA",$JOB,I,2)
SET @^UTILITY("LA",$JOB,I,1)=V
+1 QUIT
MINUS SET DX=0
SET DY=21
XECUTE XY
READ !,"SUBTRACT WHICH CELL TYPE: ",TYPE#1:DTIME
IF '$TEST
SET FLAG=1
QUIT
+1 IF TYPE=""
GOTO MI2
IF U[TYPE
SET FLAG=1
QUIT
+2 IF KEY'[TYPE
WRITE *7," ??"
GOTO MINUS
+3 IF TY(TYPE)>0
SET TY(TYPE)=TY(TYPE)-1
IF '$DATA(NC(TYPE))
IF TOTAL>0
SET TOTAL=TOTAL-1
MI2 DO HD3
QUIT
HD1 ;IHS/ANMC/CLS 1O/14/90 HRCN
WRITE @IOF,!!,"Patient name: ",PNM,?45,"HRCN: ",HRCN
QUIT
HD2 SET LRDY=$Y
SET DX=0
SET DY=$Y
XECUTE XY
WRITE !,?3,"WBC MORPHOLOGY ('?' = DISPLAY, '!' = COMMENTS, '-' = MINUS, <RETURN> = EXIT)"
FOR I=1:1:T1
WRITE !,"KEY",?7,T1(I),!,"TEST",?7,T2(I),!!
HD3 SET DX=0
SET DY=21
XECUTE XY
WRITE !,?18,"TOTAL:",$JUSTIFY(TOTAL,3)," "
QUIT
HD4 WRITE !!,?34,"> CBC PROFILE <",!
+1 SET I=1
FOR C=1:0
SET C=$ORDER(^LR(LRDFN,"CH",LRDAT,C))
IF C'>0
QUIT
SET V=^(C)
SET X=$ORDER(^LAB(60,"C","CH;"_C_";1",0))
IF X>0
WRITE $PIECE(^LAB(60,X,0),U,1),": ",$PIECE(V,U,1)_" "_$PIECE(V,U,2),?(I*25)
SET I=I+1
IF I>3
WRITE !
SET I=1
+2 QUIT
COM WRITE !,"Comment: ",RMK,!
IF RMK=""
READ RMK:DTIME
GOTO COM2
+1 SET Y=RMK
DO RW^LRDIED
SET RMK=$SELECT(X="@":"",1:Y)
COM2 DO HD1
DO HD4
DO HD2
QUIT
