- LAKUR ;SLC/RWF - KEYBOARD URINE COUNTER ;8/16/90 10:39 ;
- ;;5.2;AUTOMATED LAB INSTRUMENTS;;Sep 27, 1994
- ;CROSS LINK BY ID = ACCESSION
- LA1 S:$D(ZTQUEUED) ZTREQ="@" S LANM=$T(+0),TSK=$O(^LAB(62.4,"C",LANM,0)),U="^" I TSK<1 W !,"AUTO INSTRUMENT FILE NOT SETUP RIGHT" G QUIT
- W !!?20,"KEYBOARD URINALYSIS ENTRY",!!
- S LRTOP=$P(^LAB(69.9,1,1),U,1) D ^LASET G:'TSK QUIT K ^LA("LOCK",TSK)
- S SS="CH",IOP="HOME",%ZIS="" S:'$D(DTIME) DTIME=300 D ^%ZIS S XY=$P(^%ZIS(2,IOST(0),1),U,5)
- S LRAN=0,LRAA=WL,LRAD=DT,LAOVER=1 D INT
- LA2 K Y,TV S (A,TOUT)=0,RMK="" D NEXT,WLN G QUIT:LRAN<1
- S FLAG=0 D ^LAKUR1 G LA2:FLAG
- SAVE ;G LOST:'$D(Y(2)) F I=0:0 S I=$O(TC(I)) Q:I<1 X TC(I,2) S:$D(V) @TC(I,1)=V
- S ID=LRAN,TRAY=1,CUP=ID,IDE=0
- LA3 X LAGEN G LA2:'ISQN ;Can be changed by the cross-link code
- S Z=TSK_">" F I=0:0 S I=$O(TV(I)) Q:I<1 S:TV(I,1)]"" ^LAH(LWL,1,ISQN,I)=TV(I,1),Z=Z_TV(I,1)_" "
- I $D(RMK),$L(RMK) D RMK^LASET
- D WRITE G LA2
- WLN W !,"Accession NUMBER: ",LRAN R "//",X:DTIME S:X="" X=LRAN G LW:X["?",END:X["^"!'$T,WLN:+X'=X!(X<0)!(X>99999)!(X[".") S:X'="" LRAN=X IF '$D(^LRO(68,LRAA,1,LRAD,1,LRAN,0)) W !,"NOT ON FILE" D NEXT G WLN
- S LRDFN=+^LRO(68,LRAA,1,LRAD,1,LRAN,0),LRACC=$S($D(^(.2)):^(.2),1:""),LRDAT=9999999-$S($D(^(3)):^(3),1:0),LRODT=$S($P(^(0),U,4):$P(^(0),U,4),1:$P(^(0),U,3)),LRSN=$P(^(0),U,5)
- S LRDPF=$P(^LR(LRDFN,0),U,2),DFN=$P(^(0),U,3) D PT^LRX
- PR W !!,"Patine name: ",PNM," SSN: ",SSN," Acc: ",LRACC
- W !,"Is this the correct patient:" S %=1 D YN^DICN G PR:%=0,WLN:%=2 S:%=-1 LRAN=-1 Q
- Q
- LW W !,"Enter an accession number to enter URINALYSIS results on." G WLN
- NEXT S LRAN=$O(^LRO(68,LRAA,1,LRAD,1,LRAN)) S:LRAN'>0 LRAN="^" Q
- END S LRAN=-1 Q
- Q
- INT K KEY F I=0:0 S I=$O(^TMP("LA",$J,I)) Q:I'>0 S J=I+29\30-1,I3=^(I,3),I4=^(4),X=^(0) D INT2
- S ^TMP("LA",$J,99)="" Q
- INT2 S I1=$P(^LAB(60,X,.1),U,1),DA=+^(.2),DD=^DD(63.04,DA,0),^TMP("LA",$J,I,.1)=I1,^("DD")=DD
- I $D(KEY(J,I4)) W $C(7),!!,">> The same KEY (",I4,") is set for more than one TEST (",I1," screen ",$S(J=0:"main",J=1:"cast",1:"crystal"),")<<",!!,$C(7) Q
- S ^TMP($J,J,I)=I4,KEY(J,I4)="" S:I3=2 ^TMP($J,"NC",I)=""
- Q
- IN S CNT=^LA(TSK,"I",0)+1 IF '$D(^(CNT)) S TOUT=TOUT+1 Q:TOUT>9 H 9 G IN
- S ^LA(TSK,"I",0)=CNT,IN=^(CNT),TOUT=0
- Q
- OUT S CNT=^LAB(TQ,"O")+1,^("O")=CNT,^("O",CNT)=TSK_OUT
- LOCK ^LAB("Q") S Q=^LAB("Q")+1,^("Q")=Q,^("Q",Q)=TQ LOCK
- Q
- WRITE W !,Z
- Q
- QUIT K %,A,ACK,ASK,BASE,C,CENUM,CHK,CNT,CODE,CONT,CUP,DA,DATYP,DD,DFN,DONE,DPF,DX,DY,ECHOALL,ER,FLAG,HDR,HOME,HRD,I,I1,I3,I4,ID,IDE,IDENT,IDT,IN,ISQN,J,K,KEY,L,LAGEN,LACT,LALCT,LANM,LINE
- K LINK,LOG,LRAA,LRACC,LRAD,LRAN,LRDAT,LRDFN,LRDPF,LRDY,LRIO,LRODT,LROVER,LRPGM,LRSET,LRSN,LRSUBS,LRTIME,LRTOP,LRTST,LWL,M,METH,NAK,NC,NOW,OUT,PNM,Q,RMK,RT,SS
- K SSN,STORE,T,T1,T2,TC,TEMP,TOTAL,TOUT,TP,TQ,TRAP,TRAY,TRY,TSK,TV,TY,TYPE,V,WDT,WL,X,XY,Y,YY,Z,ZTSK,^TMP($J),^("LA",$J)
- Q
- TRAP D ^LABERR S T=TSK D SET^LAB G @("LA2^"_LANM) ;ERROR TRAP
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLAKUR 2922 printed Feb 18, 2025@23:09:19 Page 2
- LAKUR ;SLC/RWF - KEYBOARD URINE COUNTER ;8/16/90 10:39 ;
- +1 ;;5.2;AUTOMATED LAB INSTRUMENTS;;Sep 27, 1994
- +2 ;CROSS LINK BY ID = ACCESSION
- LA1 if $DATA(ZTQUEUED)
- SET ZTREQ="@"
- SET LANM=$TEXT(+0)
- SET TSK=$ORDER(^LAB(62.4,"C",LANM,0))
- SET U="^"
- IF TSK<1
- WRITE !,"AUTO INSTRUMENT FILE NOT SETUP RIGHT"
- GOTO QUIT
- +1 WRITE !!?20,"KEYBOARD URINALYSIS ENTRY",!!
- +2 SET LRTOP=$PIECE(^LAB(69.9,1,1),U,1)
- DO ^LASET
- if 'TSK
- GOTO QUIT
- KILL ^LA("LOCK",TSK)
- +3 SET SS="CH"
- SET IOP="HOME"
- SET %ZIS=""
- if '$DATA(DTIME)
- SET DTIME=300
- DO ^%ZIS
- SET XY=$PIECE(^%ZIS(2,IOST(0),1),U,5)
- +4 SET LRAN=0
- SET LRAA=WL
- SET LRAD=DT
- SET LAOVER=1
- DO INT
- LA2 KILL Y,TV
- SET (A,TOUT)=0
- SET RMK=""
- DO NEXT
- DO WLN
- if LRAN<1
- GOTO QUIT
- +1 SET FLAG=0
- DO ^LAKUR1
- if FLAG
- GOTO LA2
- SAVE ;G LOST:'$D(Y(2)) F I=0:0 S I=$O(TC(I)) Q:I<1 X TC(I,2) S:$D(V) @TC(I,1)=V
- +1 SET ID=LRAN
- SET TRAY=1
- SET CUP=ID
- SET IDE=0
- LA3 ;Can be changed by the cross-link code
- XECUTE LAGEN
- if 'ISQN
- GOTO LA2
- +1 SET Z=TSK_">"
- FOR I=0:0
- SET I=$ORDER(TV(I))
- if I<1
- QUIT
- if TV(I,1)]""
- SET ^LAH(LWL,1,ISQN,I)=TV(I,1)
- SET Z=Z_TV(I,1)_" "
- +2 IF $DATA(RMK)
- IF $LENGTH(RMK)
- DO RMK^LASET
- +3 DO WRITE
- GOTO LA2
- WLN WRITE !,"Accession NUMBER: ",LRAN
- READ "//",X:DTIME
- if X=""
- SET X=LRAN
- if X["?"
- GOTO LW
- if X["^"!'$TEST
- GOTO END
- if +X'=X!(X<0)!(X>99999)!(X[".")
- GOTO WLN
- if X'=""
- SET LRAN=X
- IF '$DATA(^LRO(68,LRAA,1,LRAD,1,LRAN,0))
- WRITE !,"NOT ON FILE"
- DO NEXT
- GOTO WLN
- +1 SET LRDFN=+^LRO(68,LRAA,1,LRAD,1,LRAN,0)
- SET LRACC=$SELECT($DATA(^(.2)):^(.2),1:"")
- SET LRDAT=9999999-$SELECT($DATA(^(3)):^(3),1:0)
- SET LRODT=$SELECT($PIECE(^(0),U,4):$PIECE(^(0),U,4),1:$PIECE(^(0),U,3))
- SET LRSN=$PIECE(^(0),U,5)
- +2 SET LRDPF=$PIECE(^LR(LRDFN,0),U,2)
- SET DFN=$PIECE(^(0),U,3)
- DO PT^LRX
- PR WRITE !!,"Patine name: ",PNM," SSN: ",SSN," Acc: ",LRACC
- +1 WRITE !,"Is this the correct patient:"
- SET %=1
- DO YN^DICN
- if %=0
- GOTO PR
- if %=2
- GOTO WLN
- if %=-1
- SET LRAN=-1
- QUIT
- +2 QUIT
- LW WRITE !,"Enter an accession number to enter URINALYSIS results on."
- GOTO WLN
- NEXT SET LRAN=$ORDER(^LRO(68,LRAA,1,LRAD,1,LRAN))
- if LRAN'>0
- SET LRAN="^"
- QUIT
- END SET LRAN=-1
- QUIT
- +1 QUIT
- INT KILL KEY
- FOR I=0:0
- SET I=$ORDER(^TMP("LA",$JOB,I))
- if I'>0
- QUIT
- SET J=I+29\30-1
- SET I3=^(I,3)
- SET I4=^(4)
- SET X=^(0)
- DO INT2
- +1 SET ^TMP("LA",$JOB,99)=""
- QUIT
- INT2 SET I1=$PIECE(^LAB(60,X,.1),U,1)
- SET DA=+^(.2)
- SET DD=^DD(63.04,DA,0)
- SET ^TMP("LA",$JOB,I,.1)=I1
- SET ^("DD")=DD
- +1 IF $DATA(KEY(J,I4))
- WRITE $CHAR(7),!!,">> The same KEY (",I4,") is set for more than one TEST (",I1," screen ",$SELECT(J=0:"main",J=1:"cast",1:"crystal"),")<<",!!,$CHAR(7)
- QUIT
- +2 SET ^TMP($JOB,J,I)=I4
- SET KEY(J,I4)=""
- if I3=2
- SET ^TMP($JOB,"NC",I)=""
- +3 QUIT
- IN SET CNT=^LA(TSK,"I",0)+1
- IF '$DATA(^(CNT))
- SET TOUT=TOUT+1
- if TOUT>9
- QUIT
- HANG 9
- GOTO IN
- +1 SET ^LA(TSK,"I",0)=CNT
- SET IN=^(CNT)
- SET TOUT=0
- +2 QUIT
- OUT SET CNT=^LAB(TQ,"O")+1
- SET ^("O")=CNT
- SET ^("O",CNT)=TSK_OUT
- +1 LOCK ^LAB("Q")
- SET Q=^LAB("Q")+1
- SET ^("Q")=Q
- SET ^("Q",Q)=TQ
- LOCK
- +2 QUIT
- WRITE WRITE !,Z
- +1 QUIT
- QUIT KILL %,A,ACK,ASK,BASE,C,CENUM,CHK,CNT,CODE,CONT,CUP,DA,DATYP,DD,DFN,DONE,DPF,DX,DY,ECHOALL,ER,FLAG,HDR,HOME,HRD,I,I1,I3,I4,ID,IDE,IDENT,IDT,IN,ISQN,J,K,KEY,L,LAGEN,LACT,LALCT,LANM,LINE
- +1 KILL LINK,LOG,LRAA,LRACC,LRAD,LRAN,LRDAT,LRDFN,LRDPF,LRDY,LRIO,LRODT,LROVER,LRPGM,LRSET,LRSN,LRSUBS,LRTIME,LRTOP,LRTST,LWL,M,METH,NAK,NC,NOW,OUT,PNM,Q,RMK,RT,SS
- +2 KILL SSN,STORE,T,T1,T2,TC,TEMP,TOTAL,TOUT,TP,TQ,TRAP,TRAY,TRY,TSK,TV,TY,TYPE,V,WDT,WL,X,XY,Y,YY,Z,ZTSK,^TMP($JOB),^("LA",$JOB)
- +3 QUIT
- TRAP ;ERROR TRAP
- DO ^LABERR
- SET T=TSK
- DO SET^LAB
- GOTO @("LA2^"_LANM)