- LRSLOW ;SLC/CJS/DALISC/FHS - MODIFIED FAST ENTRY ;8/11/97
- ;;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 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 %
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLRSLOW 3769 printed Feb 18, 2025@23:46:13 Page 2
- LRSLOW ;SLC/CJS/DALISC/FHS - MODIFIED FAST ENTRY ;8/11/97
- +1 ;;5.2;LAB SERVICE;**100,121**;Sep 27, 1994
- +2 KILL LRLONG
- +3 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 KILL LRTN,LRTS,LRTX,LRUNQ,LRURG,LRUSI,LRUSNM,^TMP("LR",$JOB,"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 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
- +5 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 %