LRSLOW ; IHS/DIR/AAB - MODIFIED FAST ENTRY 8/11/97 ; [ 8/11/97 9:40 AM ]
;;5.2;LR;**1003**;JUN 01, 1998
;;5.2;LAB SERVICE;**100,121**;Sep 27, 1994
K LRLONG
S LRLONG=""
SHORT S LRPANEL=0,LROUTINE=$P(^LAB(69.9,1,3),U,2),LRPTP=-1 I '$D(LRLONG) W !,"BYPASSING ORDER ENTRY!!",$C(7)
I $D(^LAB(69.9,1,"RO")),+$H'=^("RO") W $C(7),!,"ROLLOVER ",$S($P(^("RO"),U,2):"IS RUNNING.",1:"HAS NOT RUN.")," ACCESSIONING SHOULDN'T BE DONE NOW.",$C(7),!," Are you sure you want to continue"
I $T S %=2 D YN^DICN W:%=0 !,"Not sure?" I %'=1 W !,"OK, try later." Q
SH W !,"Do you want to enter draw times" S %=2 D YN^DICN S LRADT=(%=1) Q:%=-1
I %=0 W !,"If you answer 'yes', you will be asked for the approximate time the specimen",!,"was taken from the patient. Otherwise, the current time will be assumed." G SH
AMIS K LRCDEF,LRCDEF0 I $D(LRAA),$P(LRPARAM,U,14),$P($G(^LRO(68,LRAA,0)),U,16) D ^LRCAPV I LREND S LREND=0 G QUIT
S U="^",X="N",%DT="T" D ^%DT S LRNT=Y,LRODT=DT,LRAD=DT,LRIDT=9999999-Y,LRCDT=Y_"^1",LRSAMP="",LRURG=4 K DFN,DIC S DIC(0)="EMQ"_$S($P(LRPARAM,U,6):"L",1:"") D ^LRDPA G:(LRDFN=-1)!$D(DUOUT)!$D(DTOUT) QUIT
S:'$D(^LRO(69,LRODT,0)) ^(0)=$P(^LRO(69,0),U,1,2)_U_LRODT_U_(1+$P(^(0),U,4)),^LRO(69,LRODT,0)=LRODT,^LRO(69,"B",LRODT,LRODT)="" S %H=$H-60 D YMD^LRX S LRTM60=9999999-X
QSN1 D PT^LRX K DR S LRLLOC=$S($L(LRWRD):LRWRD,$D(^LR(LRDFN,.1)):^(.1),1:"UNKNOWN") D:$L(LRWRD) DPT^LRWU
Q12 I $D(LRLONG) D LOC^LRWU G QUIT:LREND
Q11 S LRPRAC="" I $D(LRLONG) D PRAC^LRWU1 I LREND W !!,$C(7),"ORDER CANCELED",!! G QUIT
S LRLWC="",LRNN=1 D ^LROW1 G QUIT:'$D(X3) S S9=LRSPEC
QSN2 IF LRADT S %DT("A")="DRAW DATE/TIME: ",%DT(0)="-N",%DT="EATPX" D ^%DT K %DT G:Y<0 QUIT S LRCDT=Y_U,LRIDT=9999999-Y G QSN2:Y<1
S LRSNO=LRDFN_U_DUZ_U_LRSAMP_"^^"_+LRCDT_U_LRPRAC_U_LRLLOC
S LRNCWL=1 D REST^LROW2 K LRNCWL S ^LRO(69,LRODT,1,LRSN,1)=+LRCDT_"^^"_DUZ_"^C^^^^"_DUZ(2),^LRO(69,"AA",+$G(^(.1)),LRODT_"|"_LRSN)=""
S LRSPEC=S9,LRTSTS=0,LRNOLABL=1 D ^LRWLST K LRNOLABL Q:'$D(LRAN)
LROE ;from LROE1
S LRLLOC=$P(^LRO(69,LRODT,1,LRSN,0),U,7) S:'$L(LRLLOC) LRLLOC=0 K LROE
S I1=0 F S I1=$O(^LRO(69,LRODT,1,LRSN,2,I1)) Q:I1<1 S X=^(I1,0) I $P(X,U,4) S LRAA=$P(X,U,4),LRAN=$P(X,U,5),LRAD=$P(X,U,3) I '$D(LROE(LRAD_LRAA_LRAN)) S LROE(LRAD_LRAA_LRAN)="" D LROE1
D QUIT Q:'$D(LRSLOW) S LRLONG="" G SHORT
LROE1 S LRX=$G(^LRO(68,LRAA,0)) S LRIDIV=$S($L($P(LRX,U,19)):$P(LRX,U,19),1:"CP") I $P(LRX,U,2)="CH" D:$P(LRPARAM,U,14)&($P($G(^LRO(68,LRAA,0)),U,16)) ^LRCAPV D ^LRVER1
I $P(LRX,U,2)="MI" S LRPTP=-1,LRMIDEF=$P(^LAB(69.9,1,1),U,10),LRMIOTH=$P(^(0),U,11) D PAT1^LRMIEDZ2 K LRMIDEF,LRMIOTH
K LRX Q
QUIT K ^TMP("LR",$J,"TMP"),%,A,AGE,D1,D2,DFN,DIE,DL,DLAYGO,DOB,DQ,DR,DX,H8,I,J,K,LRAA,LRACC,LRAD,LRADT,LRAN,LRAP,LRCDT,LRCW,I1
K LRCWDT,LRD,LRDAT,LRDEL,LRDFN,LRDPF,LRDV,LRDVF,LREAL,LREDIT,LREND,LRFFLG,LRFP,LRIDT,LRIN,LRINI,LRIX,DIC,LRORD,LRSB
K LRLBLBP,LRLCT,LRLDT,LRLLOC,LRLONG,LRMETH,LRNAME,LRNG,LRNG2,LRNG3,LRNG4,LRNG5,LRNP,LRNT,LRNTN,LRNX,LRODT,LROUT,LROUTINE,LROWDT,LROWLE,LRPR,LRPRAC,LRRB,LRPTP,LRSAMP,LRSN,LRSPEC,LRSS,LRSSP,LRST,LRSUB,LRSUM,LRTB,LRTD,LRTEST
;K LRTN,LRTS,LRTX,LRUNQ,LRURG,LRUSI,LRUSNM,^TMP("LR",$J,"VTO"),LRWL0,LRWLC,LRWRD,LRXD,LRXDH,LRXDP,LRYR,PNM,S,S9,SEX,SSN,T,X,X1,Y,Z,LRACD,LRADDTST,LRAOD,LRBED,LRCSS,LRDTO,LREXEC,LRFLOG,LRGCOM,LRGVP,LRIOZERO,LRNIDT,LROCN,LROID,LROLRDFN
K LRTN,LRTS,LRTX,LRUNQ,LRURG,LRUSI,LRUSNM,^TMP("LR",$J,"VTO"),LRWL0,LRWLC,LRWRD,LRXD,LRXDH,LRXDP,LRYR,PNM,S,S9,SEX,SSN,HRCN,T,X,X1,Y,Z,LRACD,LRADDTST,LRAOD,LRBED,LRCSS,LRDTO,LREXEC,LRFLOG,LRGCOM,LRGVP,LRIOZERO,LRNIDT,LROCN,LROID,LROLRDFN
;IHS/ANMC/CLS 08/18/96
K LRCCOM,LRCFL,LRCS,LRCSN,LRCSP,LRCSX,LREXP,LRLWC,LRM,LRMAX,LRNN,LRSNO,LRTSTN,LRTY,LRVF,LRVRM,LRXS,I5,S2,S5,T1,POP,X2,X3,X9,LRORDER,LRORDR,LRORDTIM,LRORIFN,LROSN,LRPER,LRPHSET,LRPLOC,LRSPCDSC,LRSSQ,LRSSX,LRSVSN,LRTEC,LRTJ,LRTP,LRTSTNM
K LRTCOM,LROE,LRUR,LRVOL,LRWPC,PNM,LROLLOC,LRTREA,LRMAX2,LRMX,LRCAPLOC,LRCOM,LRXST,LRY,LRJ,LRLABKY,LRLBL,LRMA,LRMAX1,LRNOW,LRODTSV,LRPANEL,LRSNSV,LRTNSV D END^LRMIEDZ Q
EN S LRLONG="" G SHORT
% R %:DTIME Q:%=""!(%["N")!(%["Y") W !,"Answer 'Y' or 'N': " G %
LRSLOW ; IHS/DIR/AAB - MODIFIED FAST ENTRY 8/11/97 ; [ 8/11/97 9:40 AM ]
+1 ;;5.2;LR;**1003**;JUN 01, 1998
+2 ;;5.2;LAB SERVICE;**100,121**;Sep 27, 1994
+3 KILL LRLONG
+4 SET LRLONG=""
SHORT SET LRPANEL=0
SET LROUTINE=$PIECE(^LAB(69.9,1,3),U,2)
SET LRPTP=-1
IF '$DATA(LRLONG)
WRITE !,"BYPASSING ORDER ENTRY!!",$CHAR(7)
+1 IF $DATA(^LAB(69.9,1,"RO"))
IF +$HOROLOG'=^("RO")
WRITE $CHAR(7),!,"ROLLOVER ",$SELECT($PIECE(^("RO"),U,2):"IS RUNNING.",1:"HAS NOT RUN.")," ACCESSIONING SHOULDN'T BE DONE NOW.",$CHAR(7),!," Are you sure you want to continue"
+2 IF $TEST
SET %=2
DO YN^DICN
IF %=0
WRITE !,"Not sure?"
IF %'=1
WRITE !,"OK, try later."
QUIT
SH WRITE !,"Do you want to enter draw times"
SET %=2
DO YN^DICN
SET LRADT=(%=1)
IF %=-1
QUIT
+1 IF %=0
WRITE !,"If you answer 'yes', you will be asked for the approximate time the specimen",!,"was taken from the patient. Otherwise, the current time will be assumed."
GOTO SH
AMIS KILL LRCDEF,LRCDEF0
IF $DATA(LRAA)
IF $PIECE(LRPARAM,U,14)
IF $PIECE($GET(^LRO(68,LRAA,0)),U,16)
DO ^LRCAPV
IF LREND
SET LREND=0
GOTO QUIT
+1 SET U="^"
SET X="N"
SET %DT="T"
DO ^%DT
SET LRNT=Y
SET LRODT=DT
SET LRAD=DT
SET LRIDT=9999999-Y
SET LRCDT=Y_"^1"
SET LRSAMP=""
SET LRURG=4
KILL DFN,DIC
SET DIC(0)="EMQ"_$SELECT($PIECE(LRPARAM,U,6):"L",1:"")
DO ^LRDPA
IF (LRDFN=-1)!$DATA(DUOUT)!$DATA(DTOUT)
GOTO QUIT
+2 IF '$DATA(^LRO(69,LRODT,0))
SET ^(0)=$PIECE(^LRO(69,0),U,1,2)_U_LRODT_U_(1+$PIECE(^(0),U,4))
SET ^LRO(69,LRODT,0)=LRODT
SET ^LRO(69,"B",LRODT,LRODT)=""
SET %H=$HOROLOG-60
DO YMD^LRX
SET LRTM60=9999999-X
QSN1 DO PT^LRX
KILL DR
SET LRLLOC=$SELECT($LENGTH(LRWRD):LRWRD,$DATA(^LR(LRDFN,.1)):^(.1),1:"UNKNOWN")
IF $LENGTH(LRWRD)
DO DPT^LRWU
Q12 IF $DATA(LRLONG)
DO LOC^LRWU
IF LREND
GOTO QUIT
Q11 SET LRPRAC=""
IF $DATA(LRLONG)
DO PRAC^LRWU1
IF LREND
WRITE !!,$CHAR(7),"ORDER CANCELED",!!
GOTO QUIT
+1 SET LRLWC=""
SET LRNN=1
DO ^LROW1
IF '$DATA(X3)
GOTO QUIT
SET S9=LRSPEC
QSN2 IF LRADT
SET %DT("A")="DRAW DATE/TIME: "
SET %DT(0)="-N"
SET %DT="EATPX"
DO ^%DT
KILL %DT
IF Y<0
GOTO QUIT
SET LRCDT=Y_U
SET LRIDT=9999999-Y
IF Y<1
GOTO QSN2
+1 SET LRSNO=LRDFN_U_DUZ_U_LRSAMP_"^^"_+LRCDT_U_LRPRAC_U_LRLLOC
+2 SET LRNCWL=1
DO REST^LROW2
KILL LRNCWL
SET ^LRO(69,LRODT,1,LRSN,1)=+LRCDT_"^^"_DUZ_"^C^^^^"_DUZ(2)
SET ^LRO(69,"AA",+$GET(^(.1)),LRODT_"|"_LRSN)=""
+3 SET LRSPEC=S9
SET LRTSTS=0
SET LRNOLABL=1
DO ^LRWLST
KILL LRNOLABL
IF '$DATA(LRAN)
QUIT
LROE ;from LROE1
+1 SET LRLLOC=$PIECE(^LRO(69,LRODT,1,LRSN,0),U,7)
IF '$LENGTH(LRLLOC)
SET LRLLOC=0
KILL LROE
+2 SET I1=0
FOR
SET I1=$ORDER(^LRO(69,LRODT,1,LRSN,2,I1))
IF I1<1
QUIT
SET X=^(I1,0)
IF $PIECE(X,U,4)
SET LRAA=$PIECE(X,U,4)
SET LRAN=$PIECE(X,U,5)
SET LRAD=$PIECE(X,U,3)
IF '$DATA(LROE(LRAD_LRAA_LRAN))
SET LROE(LRAD_LRAA_LRAN)=""
DO LROE1
+3 DO QUIT
IF '$DATA(LRSLOW)
QUIT
SET LRLONG=""
GOTO SHORT
LROE1 SET LRX=$GET(^LRO(68,LRAA,0))
SET LRIDIV=$SELECT($LENGTH($PIECE(LRX,U,19)):$PIECE(LRX,U,19),1:"CP")
IF $PIECE(LRX,U,2)="CH"
IF $PIECE(LRPARAM,U,14)&($PIECE($GET(^LRO(68,LRAA,0)),U,16))
DO ^LRCAPV
DO ^LRVER1
+1 IF $PIECE(LRX,U,2)="MI"
SET LRPTP=-1
SET LRMIDEF=$PIECE(^LAB(69.9,1,1),U,10)
SET LRMIOTH=$PIECE(^(0),U,11)
DO PAT1^LRMIEDZ2
KILL LRMIDEF,LRMIOTH
+2 KILL LRX
QUIT
QUIT KILL ^TMP("LR",$JOB,"TMP"),%,A,AGE,D1,D2,DFN,DIE,DL,DLAYGO,DOB,DQ,DR,DX,H8,I,J,K,LRAA,LRACC,LRAD,LRADT,LRAN,LRAP,LRCDT,LRCW,I1
+1 KILL LRCWDT,LRD,LRDAT,LRDEL,LRDFN,LRDPF,LRDV,LRDVF,LREAL,LREDIT,LREND,LRFFLG,LRFP,LRIDT,LRIN,LRINI,LRIX,DIC,LRORD,LRSB
+2 KILL LRLBLBP,LRLCT,LRLDT,LRLLOC,LRLONG,LRMETH,LRNAME,LRNG,LRNG2,LRNG3,LRNG4,LRNG5,LRNP,LRNT,LRNTN,LRNX,LRODT,LROUT,LROUTINE,LROWDT,LROWLE,LRPR,LRPRAC,LRRB,LRPTP,LRSAMP,LRSN,LRSPEC,LRSS,LRSSP,LRST,LRSUB,LRSUM,LRTB,LRTD,LRTEST
+3 ;K LRTN,LRTS,LRTX,LRUNQ,LRURG,LRUSI,LRUSNM,^TMP("LR",$J,"VTO"),LRWL0,LRWLC,LRWRD,LRXD,LRXDH,LRXDP,LRYR,PNM,S,S9,SEX,SSN,T,X,X1,Y,Z,LRACD,LRADDTST,LRAOD,LRBED,LRCSS,LRDTO,LREXEC,LRFLOG,LRGCOM,LRGVP,LRIOZERO,LRNIDT,LROCN,LROID,LROLRDFN
+4 KILL LRTN,LRTS,LRTX,LRUNQ,LRURG,LRUSI,LRUSNM,^TMP("LR",$JOB,"VTO"),LRWL0,LRWLC,LRWRD,LRXD,LRXDH,LRXDP,LRYR,PNM,S,S9,SEX,SSN,HRCN,T,X,X1,Y,Z,LRACD,LRADDTST,LRAOD,LRBED,LRCSS,LRDTO,LREXEC,LRFLOG,LRGCOM,LRGVP,LRIOZERO,LRNIDT,LROCN,LROID,LROLRDFN
+5 ;IHS/ANMC/CLS 08/18/96
+6 KILL LRCCOM,LRCFL,LRCS,LRCSN,LRCSP,LRCSX,LREXP,LRLWC,LRM,LRMAX,LRNN,LRSNO,LRTSTN,LRTY,LRVF,LRVRM,LRXS,I5,S2,S5,T1,POP,X2,X3,X9,LRORDER,LRORDR,LRORDTIM,LRORIFN,LROSN,LRPER,LRPHSET,LRPLOC,LRSPCDSC,LRSSQ,LRSSX,LRSVSN,LRTEC,LRTJ,LRTP,LRTSTNM
+7 KILL LRTCOM,LROE,LRUR,LRVOL,LRWPC,PNM,LROLLOC,LRTREA,LRMAX2,LRMX,LRCAPLOC,LRCOM,LRXST,LRY,LRJ,LRLABKY,LRLBL,LRMA,LRMAX1,LRNOW,LRODTSV,LRPANEL,LRSNSV,LRTNSV
DO END^LRMIEDZ
QUIT
EN SET LRLONG=""
GOTO SHORT
% READ %:DTIME
IF %=""!(%["N")!(%["Y")
QUIT
WRITE !,"Answer 'Y' or 'N': "
GOTO %
