LAKUR1 ;SLC/RWF - URINALYSIS Part 2 ; 9/19/87 18:36 ;
;;5.2;AUTOMATED LAB INSTRUMENTS;;Sep 27, 1994
K TY S T3=0 D INIT F N1=0:0 S N1=$O(^TMP("LA",$J,N1)) Q:N1>30!(N1'>0) S I3=^(N1,3),I4=^(4) I I3 S TYPE=I4 W ! D RESULT
D HD1,HD4,HD2
L F J=0:0 Q:FLAG!DONE S DX=0,DY=22 X XY W !,?40,*13,"URINE: " R TYPE#1:DTIME D CHECK
D STORE:DONE
K X,A,DATYP,X,DD,DA,CODE,TYPE,CONT,DONE,J,K,T1,T2,T3,KEY,TY Q
CHECK I '$T!(TYPE=U) S FLAG=1 Q
S LINE=$S(TYPE="":"STOP",TYPE="!":"COM","\[]"[TYPE:"PAGE",KEY'[TYPE:"HELP",1:"RESULT") D @LINE Q
RESULT S Y=KEY(TYPE) W *13,$P(^LAB(60,^TMP("LA",$J,Y,0),0),U,1) W:$D(TY(T3,TYPE)) " ",TY(T3,TYPE),"//" R " ",X:DTIME I '$T!(X=U) S FLAG=1 Q
DELETE Q:X="" I X="@"&$D(TY(T3,TYPE)) K TY(T3,TYPE) Q
S DD=^TMP("LA",$J,Y,"DD") D SET:$P(DD,U,2)["S" X $P(DD,U,5,99) I $D(X) S TY(T3,TYPE)=X Q
HELP2 S DX=0,DY=22 W !,$C(7),$S($D(^DD(63.04,DA,3)):^(3),1:"") I $P(DD,U,2)'["S" R X:2 Q
F K=1:1 Q:$P(LRSET,";",K)="" W !,"You can enter '",$P($P(LRSET,";",K),":",1),"' which stands for ",$P($P(LRSET,";",K),":",2)
R !,"Press return to continue ",X:DTIME D HD1,HD2 Q
Q
HELP I TYPE'="?" W *13,$C(7)," INVALID KEY" R X:2 Q
S DX=0,DY=LRDY,X=0 X XY F I1=T3*30+1:9:T2 W !!!!,?7 F I=I1:1:I1+8 Q:I>T2 S X=$S($D(^TMP($J,T3,I)):^(I),1:"^"),K=$S($D(TY(T3,X)):TY(T3,X),1:"") W $J(K,8)
Q
SET S LRSET=$P(DD,U,3),%=$P($P(";"_LRSET,";"_X_":",2),";",1) I %]"" W " ",% Q
F I=1:1 S LRSUBS=$P(LRSET,";",I),Y=$F(LRSUBS,":"_X) G HUH:LRSUBS="" IF Y S X=$P(LRSUBS,":",1) W $E(LRSUBS,Y,255) Q
Q
HUH K X Q
W:X'["?" " ??" W $C(7) K X F K=1:1 Q:$P(CODE,";",K)="" W !,"YOU CAN ENTER ",$P($P(CODE,";",K),":")," WHICH STANDS FOR ",$P($P(CODE,";",K),":",2)
Q
PAGE S T3=$S(TYPE="\":0,TYPE="[":1,TYPE="]":2,1:0) D INIT Q
STOP D EVAL S T3=0
DONE R !,"ARE YOU FINISHED WITH THIS PATIENT (Y/N) Y//",X:DTIME I '$T S FLAG=1 Q
S:X="" X="Y" I "YyNn^"'[X W $C(7)," ??" G DONE
S:"Yy"[X DONE=1 S:U[X FLAG=1 D:FLAG=DONE INIT Q
Q
EVAL D HD1
F T3=0:1:2 F I=0:0 S I=$O(^TMP($J,T3,I)) Q:I="" S Y=^(I) I $D(TY(T3,Y)) W !?2,^TMP("LA",$J,I,.1),": ",?12 S V=TY(T3,Y) X ^TMP("LA",$J,I,2) W $J(V,3)
Q
STORE F T3=0:1:2 F I=0:0 S I=$O(^TMP($J,T3,I)) Q:I="" S Y=^(I) I $D(TY(T3,Y)) S V=TY(T3,Y) X ^TMP("LA",$J,I,2) S @^TMP("LA",$J,I,1)=V
Q
HD1 W @IOF,!!,"Patient name: ",PNM,?45,"SSN: ",SSN Q
HD2 W !,?10,"URINALYSIS Screen ",$P("MAIN$CAST's$CRYSTAL's","$",T3+1)
S LRDY=$Y W !,"'?'=DISPLAY, '!'=COMMENTS, '\'=MAIN, '['=CASTS, ']'=CRYSTALS, <RETURN>=EXIT" F I=1:1:T1 W !,"KEY",?7,T1(I),!,"TEST",?7,T2(I),!!
HD3 S TYPE="?" D HELP Q
HD4 Q:$O(^LR(LRDFN,"CH",LRDAT,1))<1 W !,?24,"> Urine Chem 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
INIT K KEY,T1,T2 S KEY="",N1=T3*30,N2=N1+27,T1=1,(T1(T1),T2(T1))=""
F I=0:0 S I=$O(^TMP($J,T3,I)) Q:I="" S X=^(I),KEY(X)=I,KEY=KEY_X
F I=N1+1:1:N2 S X=$S($D(^TMP("LA",$J,I,4)):^(4),1:""),Y=$S($D(^(.1)):^(.1),1:""),T1(T1)=T1(T1)_$J(X,8),T2(T1)=T2(T1)_$J(Y,8) Q:$O(^TMP($J,T3,I))="" I '(I-N1#9) S T1=T1+1,(T1(T1),T2(T1))=""
S T2=I,DONE=0,FLAG=0 D HD1,HD2 Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLAKUR1 3308 printed Dec 13, 2024@01:42:57 Page 2
LAKUR1 ;SLC/RWF - URINALYSIS Part 2 ; 9/19/87 18:36 ;
+1 ;;5.2;AUTOMATED LAB INSTRUMENTS;;Sep 27, 1994
+2 KILL TY
SET T3=0
DO INIT
FOR N1=0:0
SET N1=$ORDER(^TMP("LA",$JOB,N1))
if N1>30!(N1'>0)
QUIT
SET I3=^(N1,3)
SET I4=^(4)
IF I3
SET TYPE=I4
WRITE !
DO RESULT
+3 DO HD1
DO HD4
DO HD2
L FOR J=0:0
if FLAG!DONE
QUIT
SET DX=0
SET DY=22
XECUTE XY
WRITE !,?40,*13,"URINE: "
READ TYPE#1:DTIME
DO CHECK
+1 if DONE
DO STORE
+2 KILL X,A,DATYP,X,DD,DA,CODE,TYPE,CONT,DONE,J,K,T1,T2,T3,KEY,TY
QUIT
CHECK IF '$TEST!(TYPE=U)
SET FLAG=1
QUIT
+1 SET LINE=$SELECT(TYPE="":"STOP",TYPE="!":"COM","\[]"[TYPE:"PAGE",KEY'[TYPE:"HELP",1:"RESULT")
DO @LINE
QUIT
RESULT SET Y=KEY(TYPE)
WRITE *13,$PIECE(^LAB(60,^TMP("LA",$JOB,Y,0),0),U,1)
if $DATA(TY(T3,TYPE))
WRITE " ",TY(T3,TYPE),"//"
READ " ",X:DTIME
IF '$TEST!(X=U)
SET FLAG=1
QUIT
DELETE if X=""
QUIT
IF X="@"&$DATA(TY(T3,TYPE))
KILL TY(T3,TYPE)
QUIT
+1 SET DD=^TMP("LA",$JOB,Y,"DD")
if $PIECE(DD,U,2)["S"
DO SET
XECUTE $PIECE(DD,U,5,99)
IF $DATA(X)
SET TY(T3,TYPE)=X
QUIT
HELP2 SET DX=0
SET DY=22
WRITE !,$CHAR(7),$SELECT($DATA(^DD(63.04,DA,3)):^(3),1:"")
IF $PIECE(DD,U,2)'["S"
READ X:2
QUIT
+1 FOR K=1:1
if $PIECE(LRSET,";",K)=""
QUIT
WRITE !,"You can enter '",$PIECE($PIECE(LRSET,";",K),":",1),"' which stands for ",$PIECE($PIECE(LRSET,";",K),":",2)
+2 READ !,"Press return to continue ",X:DTIME
DO HD1
DO HD2
QUIT
+3 QUIT
HELP IF TYPE'="?"
WRITE *13,$CHAR(7)," INVALID KEY"
READ X:2
QUIT
+1 SET DX=0
SET DY=LRDY
SET X=0
XECUTE XY
FOR I1=T3*30+1:9:T2
WRITE !!!!,?7
FOR I=I1:1:I1+8
if I>T2
QUIT
SET X=$SELECT($DATA(^TMP($JOB,T3,I)):^(I),1:"^")
SET K=$SELECT($DATA(TY(T3,X)):TY(T3,X),1:"")
WRITE $JUSTIFY(K,8)
+2 QUIT
SET SET LRSET=$PIECE(DD,U,3)
SET %=$PIECE($PIECE(";"_LRSET,";"_X_":",2),";",1)
IF %]""
WRITE " ",%
QUIT
+1 FOR I=1:1
SET LRSUBS=$PIECE(LRSET,";",I)
SET Y=$FIND(LRSUBS,":"_X)
if LRSUBS=""
GOTO HUH
IF Y
SET X=$PIECE(LRSUBS,":",1)
WRITE $EXTRACT(LRSUBS,Y,255)
QUIT
+2 QUIT
HUH KILL X
QUIT
+1 if X'["?"
WRITE " ??"
WRITE $CHAR(7)
KILL X
FOR K=1:1
if $PIECE(CODE,";",K)=""
QUIT
WRITE !,"YOU CAN ENTER ",$PIECE($PIECE(CODE,";",K),":")," WHICH STANDS FOR ",$PIECE($PIECE(CODE,";",K),":",2)
+2 QUIT
PAGE SET T3=$SELECT(TYPE="\":0,TYPE="[":1,TYPE="]":2,1:0)
DO INIT
QUIT
STOP DO EVAL
SET T3=0
DONE READ !,"ARE YOU FINISHED WITH THIS PATIENT (Y/N) Y//",X:DTIME
IF '$TEST
SET FLAG=1
QUIT
+1 if X=""
SET X="Y"
IF "YyNn^"'[X
WRITE $CHAR(7)," ??"
GOTO DONE
+2 if "Yy"[X
SET DONE=1
if U[X
SET FLAG=1
if FLAG=DONE
DO INIT
QUIT
+3 QUIT
EVAL DO HD1
+1 FOR T3=0:1:2
FOR I=0:0
SET I=$ORDER(^TMP($JOB,T3,I))
if I=""
QUIT
SET Y=^(I)
IF $DATA(TY(T3,Y))
WRITE !?2,^TMP("LA",$JOB,I,.1),": ",?12
SET V=TY(T3,Y)
XECUTE ^TMP("LA",$JOB,I,2)
WRITE $JUSTIFY(V,3)
+2 QUIT
STORE FOR T3=0:1:2
FOR I=0:0
SET I=$ORDER(^TMP($JOB,T3,I))
if I=""
QUIT
SET Y=^(I)
IF $DATA(TY(T3,Y))
SET V=TY(T3,Y)
XECUTE ^TMP("LA",$JOB,I,2)
SET @^TMP("LA",$JOB,I,1)=V
+1 QUIT
HD1 WRITE @IOF,!!,"Patient name: ",PNM,?45,"SSN: ",SSN
QUIT
HD2 WRITE !,?10,"URINALYSIS Screen ",$PIECE("MAIN$CAST's$CRYSTAL's","$",T3+1)
+1 SET LRDY=$Y
WRITE !,"'?'=DISPLAY, '!'=COMMENTS, '\'=MAIN, '['=CASTS, ']'=CRYSTALS, <RETURN>=EXIT"
FOR I=1:1:T1
WRITE !,"KEY",?7,T1(I),!,"TEST",?7,T2(I),!!
HD3 SET TYPE="?"
DO HELP
QUIT
HD4 if $ORDER(^LR(LRDFN,"CH",LRDAT,1))<1
QUIT
WRITE !,?24,"> Urine Chem 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
INIT KILL KEY,T1,T2
SET KEY=""
SET N1=T3*30
SET N2=N1+27
SET T1=1
SET (T1(T1),T2(T1))=""
+1 FOR I=0:0
SET I=$ORDER(^TMP($JOB,T3,I))
if I=""
QUIT
SET X=^(I)
SET KEY(X)=I
SET KEY=KEY_X
+2 FOR I=N1+1:1:N2
SET X=$SELECT($DATA(^TMP("LA",$JOB,I,4)):^(4),1:"")
SET Y=$SELECT($DATA(^(.1)):^(.1),1:"")
SET T1(T1)=T1(T1)_$JUSTIFY(X,8)
SET T2(T1)=T2(T1)_$JUSTIFY(Y,8)
if $ORDER(^TMP($JOB,T3,I))=""
QUIT
IF '(I-N1#9)
SET T1=T1+1
SET (T1(T1),T2(T1))=""
+3 SET T2=I
SET DONE=0
SET FLAG=0
DO HD1
DO HD2
QUIT
