Routine: LRKUR

LRKUR ;SLC/RWF- KEYBOARD URINE COUNTER ; 2/14/89  17:08 ; [ 10/14/90  8:59 PM ]

 ;;V~5.0~;LAB;;02/27/90 17:09

 ;CROSS LINK BY ID = ACCESSION

LA1 S LANM=$T(+0),TSK=$N(^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 ^LRKUR1 G LA2:FLAG

SAVE ;G LOST:'$D(Y(2)) F I=0:0 S I=$N(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=$N(TV(I)) Q:I<1  S:TV(I,1)]"" ^LAH(LWL,1,ISQN,I)=TV(I,1),Z=Z_TV(I,1)_" "

 I $L(RMK) S ^LAH(LWL,1,ISQN,1)=RMK

 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,"  HRCN: ",HRCN,"  Acc: ",LRACC  ;IHS/ANMC/CLS 10/14/90 HRCN

 W !,"Is this the correct patient:" S %=1 D YN^DICN G PR:%=0,WLN:%=2 S:%=-1 LRAN=-1 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

INT K KEY F I=0:0 S I=$O(^UTILITY("LA",$J,I)) Q:I'>0  S J=I+29\30-1,I3=^(I,3),I4=^(4),X=^(0) D INT2

 S ^UTILITY("LA",$J,99)="" Q

INT2 S I1=$P(^LAB(60,X,.1),U,1),DA=+^(.2),DD=^DD(63.04,DA,0),^UTILITY("LA",$J,I,.1)=I1,^("DD")=DD

 I $D(KEY(J,I4)) W *7,!!,">> The same KEY (",I4,") is set for more than one TEST (",I1," screen ",$S(J=0:"main",J=1:"cast",1:"crystal"),")<<",!!,*7 Q

 S ^UTILITY($J,J,I)=I4,KEY(J,I4)="" S:I3=2 ^UTILITY($J,"NC",I)=""

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

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

WRITE W !,Z

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,HRCN,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,^UTILITY($J),^("LA",$J)  ;IHS/ANMC/CLS 10/14/90 HRCN

TRAP Q  K ^LA("LOCK",TSK) S T=TSK D SET^LAB X ^LAB("X","%ET") G @(U_LANM) ;ERROR TRAP

LRKUR.m