- 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
