LRORDGUI ;IHS/OIT/MKK - LAZY ACCESSION LOGGING for IHS PATIENT CHART ONLY ;JUL 06, 2010 3:14 PM;
;;5.2;LAB SERVICE;**1027**;NOV 01, 1997
;;
; Cloned from LEDI III LRORD routine. Next two lines VA code
LRORD ;DALOI/CJS - LAZY ACCESSION LOGGING ;2/6/91 12:54 ;
;;5.2;LAB SERVICE;**100,121,153,286**;Sep 27, 1994
;;
; This code was removed from the previous IHS version of the LRORD routine
; and placed in this new routine due to the changes to the LRORD routine
; brought in with VA LR*5.2*286 --LEDI III.
;
; It was felt that the PATIENT CHART coding was overwhelming the logic
; flow of the LRORD routine.
;
D:$G(SNAPSHOT) ENTRYAUD^BLRUTIL("^LRORDGUI 0.0")
S:XQY0["LRFASTS" BLROPT="FASTORD",BLROPT(0)=$P(XQY0,U)
S XWBWRAP=1 ;IHS/ITSC/TPF 10/10/02 REQUESTED BY PATIENT CHART DEV. F.J.EVANS **1014**
S:$G(BLROPT)=""!($G(BLROPT(0))'=$P(XQY0,U)) BLROPT="MULTI",BLROPT(0)=$P(XQY0,U) ;IHS/OIRM TUC/AAB 2/1/97
;;
EN ; EP ; from EN^LRORD
D:$G(SNAPSHOT) ENTRYAUD^BLRUTIL("EN^LRORDGUI 0.0")
I $D(^LAB(69.9,1,"RO")),+$H'=+^("RO") D Q
. NEW STR
. S STR="ROLLOVER "_$S($P(^("RO"),U,2):"IS RUNNING.",1:"HAS NOT RUN.")
. S STR=STR_" CHECK WITH SITE MANAGER"
. S RESULT(1)=-1,RESULT(2)=STR
;
EN1 ; EP ; from EN1^LRORD also
D:$G(SNAPSHOT) ENTRYAUD^BLRUTIL("EN1^LRORDGUI 0.0")
D ^BLRPARAM
D ^LRPARAM
K ^TMP("LRSTIK",$J),DIC,LRURG,LRSAME,LRCOM,LRNATURE,LRTCOM
S LRORDTIM="" S:'$D(LRORDR) LRORDR="" D DT^LRX
I $D(LRADDTST) Q:LRADDTST=""
S LRFIRST=1,LRODT=DT,U="^",LRECT=0,LROUTINE=$P(^LAB(69.9,1,3),U,2)
S:$G(LRORDRR)="R" LRECT=1,LRFIRST=0
S LRECT="Y",LRODT=BPCODT,LRURG=BPCURG
I LRORDR="LC" S LRLWC="SP"
I LRORDR="SP" S LRLWC="SP"
I LRORDR="WC" S LRLWC="WC"
;
L5 ; EP ; from L5^LRORD also
D:$G(SNAPSHOT) ENTRYAUD^BLRUTIL("L5^LRORDGUI 0.0")
I LRORDR'="" D Q:Y<1 Q:$G(X)>$G(LRDAHEAD)
. S X=LRODT,%DT="T" D ^%DT I Y=-1 S RESULT(1)=1,RESULT(2)="Incorrect Date/Time Format" Q
. S LRORDTIM=$P(Y,".",2),LRODT=$P(Y,".",1),X1=Y,X2=DT D ^%DTC
. I X>$G(LRDAHEAD) S RESULT(1)=-1,RESULT(2)="Can't order more than "_$G(LRDAHEAD)_" days ahead!!"
;
I $D(LRODT),$P(LRODT,".")<DT D Q
. S RESULT(1)=-1
. S RESULT(2)="Cannot order in the Past."
;
I $D(LRFLOG) S Y=LRFLOG
;
G0 ; EP ;
D:$G(SNAPSHOT) ENTRYAUD^BLRUTIL("G0^LRORDGUI 0.0")
S (LRWP,I)=0
D:LRFLOG
. S $P(LRFLOG,U,3)=$P(^LAB(62.2,+$P(^LAB(62.6,+LRFLOG,0),U,2),0),U,2)
. S LRFLOG(0)=^LAB(62.6,+LRFLOG,0)
. S (LRWP,I)=0
. F S I=$O(^LAB(62.6,+Y,1,I)) Q:I<1 D
. . S Y(0)=$G(^LAB(62.6,+Y,1,I,0)),LRWP=LRWP+1
. . S ^TMP("LRSTIK",$J,$S($P(LRFLOG(0),"^",5):I,1:LRWP))=Y(0)
. . ; Lookup by number user enters.
. . S ^TMP("LRSTIK",$J,"B",LRWP)=$S($P(LRFLOG(0),"^",5):I,1:LRWP)
. . ; Lookup by test - used by LEDI (LRORDB) when user creates list "on-the-fly"
. . S ^TMP("LRSTIK",$J,"C",+Y(0),$S($P(LRFLOG(0),"^",5):I,1:LRWP))=""
. I LRWP>40 S LRFIRST=0 ; Don't automatically display "long" test lists.
;
D:+BPCOORDS>0 ; - PROCESSES OTHER ORDERS
. NEW BPCOORD,BPCTDTA,BPCCS,BPCTNAM,BPCCSDTA
. F I=1:1 S BPCOORD=$P(BPCOORDS,",",I) Q:+BPCOORD<1 I $D(^LAB(60,BPCOORD)) D
.. S BPCTDTA=^LAB(60,BPCOORD,0)
.. S BPCCS=$P(BPCTDTA,U,9) ;COLLECTION SAMPLE IEN
.. S BPCTNAM=$P(BPCTDTA,U,1) ;TEST NAME
.. I +BPCCS>0 D
... S BPCCSDTA=$G(^LAB(62,BPCCS,0))
... S BPCCSDTA=$P(BPCCSDTA,U,1,2)
.. S LRWP=LRWP+1
.. S ^TMP("LRSTIK",$J,LRWP)=BPCOORD_U_BPCTNAM_U_$G(BPCCS)_U_$G(BPCCSDTA)
.. S ^TMP("LRSTIK",$J,"B",LRWP)=LRWP
.. S:BPCTL'="" BPCTL=BPCTL_","_LRWP S:BPCTL="" BPCTL=LRWP
;
K I1
G G5
;
G1 S LRWP=0
D:$G(SNAPSHOT) ENTRYAUD^BLRUTIL("G1^LRORDGUI 0.0")
;
GET ; EP
D:$G(SNAPSHOT) ENTRYAUD^BLRUTIL("GET^LRORDGUI 0.0")
D Q15^LRORD2
D ^DIC K DIC("S") G:Y<1 G5
S LRWP=LRWP+1,LRY=Y
S ^TMP("LRSTIK",$J,LRWP)=$P(LRY,U,1,2)
; "B" Used to lookup by number user enters.
S ^TMP("LRSTIK",$J,"B",LRWP)=LRWP
; "C" Used by LEDI (LRORDB)
S ^TMP("LRSTIK",$J,"C",+LRY,LRWP)=""
S LRTSTS=+^TMP("LRSTIK",$J,LRWP) D GS^LRORD3
S:+LRSAMP=-1&(LRSPEC=-1) LRWP=LRWP-1
G GET:+LRSAMP=-1&(LRSPEC=-1)
S ^TMP("LRSTIK",$J,LRWP)=^TMP("LRSTIK",$J,LRWP)_U_LRSAMP_U_U_LRSPEC
G GET
;
G5 ; EP
D:$G(SNAPSHOT) ENTRYAUD^BLRUTIL("G5^LRORDGUI 0.0")
G KILL:LRWP<1
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 LRAD=DT,LRWPD=LRWP\2+(LRWP#2) D ^LRORD1GU
;
KILL ; EP
D:$G(SNAPSHOT) ENTRYAUD^BLRUTIL("KILL^LRORDGUI 0.0")
D ^LRORDK,HOME^%ZIS
Q
;
% R %:DTIME Q:%=""!(%["N")!(%["Y")!($E(%)="^") W !,"Answer 'Y' or 'N': " G %
;
EN01 ;LAB COLLECT ORDER ENTRY
ORDER ; EP
D:$G(SNAPSHOT) ENTRYAUD^BLRUTIL("ORDER^LRORDGUI 0.0")
S %=2 W !,"Do you want copies of the orders" D YN^DICN Q:%=-1 S:%=1 LRSLIP="" I %=0 D QUIZ G ORDER
S LRORDR="LC",LRLWCURG=$S($P(^LAB(69.9,1,3),U,2)'="":$P(^(3),U,2),1:9)
S:$G(BLROPT)=""!($G(BLROPT(0))'=$P(XQY0,U)) BLROPT="FASTORD",BLROPT(0)=$P(XQY0,U)
G LRORD
;
EN02 ;SEND PATIENT ORDER ENTRY
SENDPAT ; EP
D:$G(SNAPSHOT) ENTRYAUD^BLRUTIL("SENDPAT^LRORDGUI 0.0")
S %=1 W !,"Do you want copies of the orders" D YN^DICN Q:%=-1 S:%=1 LRSLIP="" I %=0 D QUIZ G SENDPAT
S LRORDR="SP"
G LRORD
;
IMMCOL ;EP - IMMEDIATE LAB COLLECTION
D:$G(SNAPSHOT) ENTRYAUD^BLRUTIL("IMMCOL^LRORDGUI 0.0")
I '$P($G(^LAB(69.9,1,7,DUZ(2),0)),U,6) W !!?5," This option is not available at the time ",!!,$C(7) Q
S LRORDR="I"
K LRODT
S:$G(BLROPT)=""!($G(BLROPT(0))'=$P(XQY0,U)) BLROPT="FASTORD",BLROPT(0)=$P(XQY0,U)
G LRORD
;
EN03 ;WARD COLLECT ORDER ENTRY
WARDCOL ; EP
D:$G(SNAPSHOT) ENTRYAUD^BLRUTIL("WARDCOL^LRORDGUI 0.0")
S %=1
W !,"Do you want copies of the orders" D YN^DICN Q:%=-1 S:%=1 LRSLIP="" I %=0 D QUIZ G WARDCOL
S:$G(BLROPT)=""!($G(BLROPT(0))'=$P(XQY0,U)) BLROPT="FASTORD",BLROPT(0)=$P(XQY0,U) ;IHS/OIRM TUC/AAB 2/13/97
S LRORDR="WC" D LRORD
Q
;
;
LEDI ; EP - Laboratory Electronic Data Exchange
D:$G(SNAPSHOT) ENTRYAUD^BLRUTIL("LEDI^LRORDGUI 0.0")
; This entry point is used to select patients from ^LRT(67, file
; Routine LRDPAREF controls patient selection, patients must already
; exist in ^DPT in order to be selected.
D ^LRPARAM
I $G(LREND) D ^LRORDK Q
;
N CONTROL,LA7,LA7SCFG,LA7X,LA7Y,LR64,LR696,LRLABLIO,LRRSTAT,LRRSITE,LRSD,LRTSN
S LRREFBAR=$$BAR^LA7SBCR
I LRREFBAR<0 D ^LRORDK Q
;
S LRRSTAT="I"
S LRRSTAT(0)=$$FIND1^DIC(64.061,"","OMX","Specimen in process","","I $P(^LAB(64.061,Y,0),U,7)=""U""")
D SITE^LA7SBCR2(.LRRSITE,"Scan Remote Site Barcode (SM)",LRREFBAR)
I LRRSITE("ERROR") D Q
. W !!,$C(7),"ERROR -- ",$P(LRRSITE("ERROR"),"^",2),!
. D ^LRORDK
;
; Get shipping manifest ID manual input
I $G(LRRSITE("SMID"))="" D
. F D SMID^LRORDB Q:LREND!($G(LRRSITE("SMID"))'="")
I $G(LREND) D ^LRORDK Q
;
; LRORDRR="R" variable indicates host accessioning of remote orders
S LRORDRR="R",LRORDR="" K LRODT
D LRORD,^LRORDK
D:$G(SNAPSHOT) ENTRYAUD^BLRUTIL("LEDI^LRORDGUI 9.0")
Q
;
;
; LRORDRR =TYPE OF ORDER, LRECT =ASK COLECTION TIME
; LRFLOG =ACCESSION TEST GROUP, IF DEFINED ON ENTRY, PRESELECTS GROUP
;
QUIZ ; EP
D:$G(SNAPSHOT) ENTRYAUD^BLRUTIL("QUIZ^LRORDGUI 0.0")
W !,"The order copy is automatically sent to the CLOSEST PRINTER,"
W !,"if a closest printer is defined for the device you are using."
W !,"Otherwise, you will be prompted with ORDER COPY DEVICE.",!
Q
LRORDGUI ;IHS/OIT/MKK - LAZY ACCESSION LOGGING for IHS PATIENT CHART ONLY ;JUL 06, 2010 3:14 PM;
+1 ;;5.2;LAB SERVICE;**1027**;NOV 01, 1997
+2 ;;
+3 ; Cloned from LEDI III LRORD routine. Next two lines VA code
LRORD ;DALOI/CJS - LAZY ACCESSION LOGGING ;2/6/91 12:54 ;
+1 ;;5.2;LAB SERVICE;**100,121,153,286**;Sep 27, 1994
+2 ;;
+3 ; This code was removed from the previous IHS version of the LRORD routine
+4 ; and placed in this new routine due to the changes to the LRORD routine
+5 ; brought in with VA LR*5.2*286 --LEDI III.
+6 ;
+7 ; It was felt that the PATIENT CHART coding was overwhelming the logic
+8 ; flow of the LRORD routine.
+9 ;
+10 IF $GET(SNAPSHOT)
DO ENTRYAUD^BLRUTIL("^LRORDGUI 0.0")
+11 IF XQY0["LRFASTS"
SET BLROPT="FASTORD"
SET BLROPT(0)=$PIECE(XQY0,U)
+12 ;IHS/ITSC/TPF 10/10/02 REQUESTED BY PATIENT CHART DEV. F.J.EVANS **1014**
SET XWBWRAP=1
+13 ;IHS/OIRM TUC/AAB 2/1/97
IF $GET">GET(BLROPT)=""!($GET">GET(BLROPT(0))'=$PIECE(XQY0,U))
SET BLROPT="MULTI"
SET BLROPT(0)=$PIECE(XQY0,U)
+14 ;;
EN ; EP ; from EN^LRORD
+1 IF $GET(SNAPSHOT)
DO ENTRYAUD^BLRUTIL("EN^LRORDGUI 0.0")
+2 IF $DATA(^LAB(69.9,1,"RO"))
IF +$HOROLOG'=+^("RO")
Begin DoDot:1
+3 NEW STR
+4 SET STR="ROLLOVER "_$SELECT($PIECE(^("RO"),U,2):"IS RUNNING.",1:"HAS NOT RUN.")
+5 SET STR=STR_" CHECK WITH SITE MANAGER"
+6 SET RESULT(1)=-1
SET RESULT(2)=STR
End DoDot:1
QUIT
+7 ;
EN1 ; EP ; from EN1^LRORD also
+1 IF $GET(SNAPSHOT)
DO ENTRYAUD^BLRUTIL("EN1^LRORDGUI 0.0")
+2 DO ^BLRPARAM
+3 DO ^LRPARAM
+4 KILL ^TMP("LRSTIK",$JOB),DIC,LRURG,LRSAME,LRCOM,LRNATURE,LRTCOM
+5 SET LRORDTIM=""
IF '$DATA(LRORDR)
SET LRORDR=""
DO DT^LRX
+6 IF $DATA(LRADDTST)
IF LRADDTST=""
QUIT
+7 SET LRFIRST=1
SET LRODT=DT
SET U="^"
SET LRECT=0
SET LROUTINE=$PIECE(^LAB(69.9,1,3),U,2)
+8 IF $GET(LRORDRR)="R"
SET LRECT=1
SET LRFIRST=0
+9 SET LRECT="Y"
SET LRODT=BPCODT
SET LRURG=BPCURG
+10 IF LRORDR="LC"
SET LRLWC="SP"
+11 IF LRORDR="SP"
SET LRLWC="SP"
+12 IF LRORDR="WC"
SET LRLWC="WC"
+13 ;
L5 ; EP ; from L5^LRORD also
+1 IF $GET(SNAPSHOT)
DO ENTRYAUD^BLRUTIL("L5^LRORDGUI 0.0")
+2 IF LRORDR'=""
Begin DoDot:1
+3 SET X=LRODT
SET %DT="T"
DO ^%DT
IF Y=-1
SET RESULT(1)=1
SET RESULT(2)="Incorrect Date/Time Format"
QUIT
+4 SET LRORDTIM=$PIECE(Y,".",2)
SET LRODT=$PIECE(Y,".",1)
SET X1=Y
SET X2=DT
DO ^%DTC
+5 IF X>$GET(LRDAHEAD)
SET RESULT(1)=-1
SET RESULT(2)="Can't order more than "_$GET(LRDAHEAD)_" days ahead!!"
End DoDot:1
IF Y<1
QUIT
IF $GET">GET(X)>$GET">GET(LRDAHEAD)
QUIT
+6 ;
+7 IF $DATA(LRODT)
IF $PIECE(LRODT,".")<DT
Begin DoDot:1
+8 SET RESULT(1)=-1
+9 SET RESULT(2)="Cannot order in the Past."
End DoDot:1
QUIT
+10 ;
+11 IF $DATA(LRFLOG)
SET Y=LRFLOG
+12 ;
G0 ; EP ;
+1 IF $GET(SNAPSHOT)
DO ENTRYAUD^BLRUTIL("G0^LRORDGUI 0.0")
+2 SET (LRWP,I)=0
+3 IF LRFLOG
Begin DoDot:1
+4 SET $PIECE(LRFLOG,U,3)=$PIECE(^LAB(62.2,+$PIECE(^LAB(62.6,+LRFLOG,0),U,2),0),U,2)
+5 SET LRFLOG(0)=^LAB(62.6,+LRFLOG,0)
+6 SET (LRWP,I)=0
+7 FOR
SET I=$ORDER(^LAB(62.6,+Y,1,I))
IF I<1
QUIT
Begin DoDot:2
+8 SET Y(0)=$GET(^LAB(62.6,+Y,1,I,0))
SET LRWP=LRWP+1
+9 SET ^TMP("LRSTIK",$JOB,$SELECT($PIECE(LRFLOG(0),"^",5):I,1:LRWP))=Y(0)
+10 ; Lookup by number user enters.
+11 SET ^TMP("LRSTIK",$JOB,"B",LRWP)=$SELECT($PIECE(LRFLOG(0),"^",5):I,1:LRWP)
+12 ; Lookup by test - used by LEDI (LRORDB) when user creates list "on-the-fly"
+13 SET ^TMP("LRSTIK",$JOB,"C",+Y(0),$SELECT($PIECE(LRFLOG(0),"^",5):I,1:LRWP))=""
End DoDot:2
+14 ; Don't automatically display "long" test lists.
IF LRWP>40
SET LRFIRST=0
End DoDot:1
+15 ;
+16 ; - PROCESSES OTHER ORDERS
IF +BPCOORDS>0
Begin DoDot:1
+17 NEW BPCOORD,BPCTDTA,BPCCS,BPCTNAM,BPCCSDTA
+18 FOR I=1:1
SET BPCOORD=$PIECE(BPCOORDS,",",I)
IF +BPCOORD<1
QUIT
IF $DATA(^LAB(60,BPCOORD))
Begin DoDot:2
+19 SET BPCTDTA=^LAB(60,BPCOORD,0)
+20 ;COLLECTION SAMPLE IEN
SET BPCCS=$PIECE(BPCTDTA,U,9)
+21 ;TEST NAME
SET BPCTNAM=$PIECE(BPCTDTA,U,1)
+22 IF +BPCCS>0
Begin DoDot:3
+23 SET BPCCSDTA=$GET(^LAB(62,BPCCS,0))
+24 SET BPCCSDTA=$PIECE(BPCCSDTA,U,1,2)
End DoDot:3
+25 SET LRWP=LRWP+1
+26 SET ^TMP("LRSTIK",$JOB,LRWP)=BPCOORD_U_BPCTNAM_U_$GET">GET(BPCCS)_U_$GET">GET(BPCCSDTA)
+27 SET ^TMP("LRSTIK",$JOB,"B",LRWP)=LRWP
+28 IF BPCTL'=""
SET BPCTL=BPCTL_","_LRWP
IF BPCTL=""
SET BPCTL=LRWP
End DoDot:2
End DoDot:1
+29 ;
+30 KILL I1
+31 GOTO G5
+32 ;
G1 SET LRWP=0
+1 IF $GET(SNAPSHOT)
DO ENTRYAUD^BLRUTIL("G1^LRORDGUI 0.0")
+2 ;
GET ; EP
+1 IF $GET(SNAPSHOT)
DO ENTRYAUD^BLRUTIL("GET^LRORDGUI 0.0")
+2 DO Q15^LRORD2
+3 DO ^DIC
KILL DIC("S")
IF Y<1
GOTO G5
+4 SET LRWP=LRWP+1
SET LRY=Y
+5 SET ^TMP("LRSTIK",$JOB,LRWP)=$PIECE(LRY,U,1,2)
+6 ; "B" Used to lookup by number user enters.
+7 SET ^TMP("LRSTIK",$JOB,"B",LRWP)=LRWP
+8 ; "C" Used by LEDI (LRORDB)
+9 SET ^TMP("LRSTIK",$JOB,"C",+LRY,LRWP)=""
+10 SET LRTSTS=+^TMP("LRSTIK",$JOB,LRWP)
DO GS^LRORD3
+11 IF +LRSAMP=-1&(LRSPEC=-1)
SET LRWP=LRWP-1
+12 IF +LRSAMP=-1&(LRSPEC=-1)
GOTO GET
+13 SET ^TMP("LRSTIK",$JOB,LRWP)=^TMP("LRSTIK",$JOB,LRWP)_U_LRSAMP_U_U_LRSPEC
+14 GOTO GET
+15 ;
G5 ; EP
+1 IF $GET(SNAPSHOT)
DO ENTRYAUD^BLRUTIL("G5^LRORDGUI 0.0")
+2 IF LRWP<1
GOTO KILL
+3 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)=""
+4 SET LRAD=DT
SET LRWPD=LRWP\2+(LRWP#2)
DO ^LRORD1GU
+5 ;
KILL ; EP
+1 IF $GET(SNAPSHOT)
DO ENTRYAUD^BLRUTIL("KILL^LRORDGUI 0.0")
+2 DO ^LRORDK
DO HOME^%ZIS
+3 QUIT
+4 ;
% READ %:DTIME
IF %=""!(%["N")!(%["Y")!($EXTRACT(%)="^")
QUIT
WRITE !,"Answer 'Y' or 'N': "
GOTO %
+1 ;
EN01 ;LAB COLLECT ORDER ENTRY
ORDER ; EP
+1 IF $GET(SNAPSHOT)
DO ENTRYAUD^BLRUTIL("ORDER^LRORDGUI 0.0")
+2 SET %=2
WRITE !,"Do you want copies of the orders"
DO YN^DICN
IF %=-1
QUIT
IF %=1
SET LRSLIP=""
IF %=0
DO QUIZ
GOTO ORDER
+3 SET LRORDR="LC"
SET LRLWCURG=$SELECT($PIECE(^LAB(69.9,1,3),U,2)'="":$PIECE(^(3),U,2),1:9)
+4 IF $GET">GET(BLROPT)=""!($GET">GET(BLROPT(0))'=$PIECE(XQY0,U))
SET BLROPT="FASTORD"
SET BLROPT(0)=$PIECE(XQY0,U)
+5 GOTO LRORD
+6 ;
EN02 ;SEND PATIENT ORDER ENTRY
SENDPAT ; EP
+1 IF $GET(SNAPSHOT)
DO ENTRYAUD^BLRUTIL("SENDPAT^LRORDGUI 0.0")
+2 SET %=1
WRITE !,"Do you want copies of the orders"
DO YN^DICN
IF %=-1
QUIT
IF %=1
SET LRSLIP=""
IF %=0
DO QUIZ
GOTO SENDPAT
+3 SET LRORDR="SP"
+4 GOTO LRORD
+5 ;
IMMCOL ;EP - IMMEDIATE LAB COLLECTION
+1 IF $GET(SNAPSHOT)
DO ENTRYAUD^BLRUTIL("IMMCOL^LRORDGUI 0.0")
+2 IF '$PIECE($GET(^LAB(69.9,1,7,DUZ(2),0)),U,6)
WRITE !!?5," This option is not available at the time ",!!,$CHAR(7)
QUIT
+3 SET LRORDR="I"
+4 KILL LRODT
+5 IF $GET">GET(BLROPT)=""!($GET">GET(BLROPT(0))'=$PIECE(XQY0,U))
SET BLROPT="FASTORD"
SET BLROPT(0)=$PIECE(XQY0,U)
+6 GOTO LRORD
+7 ;
EN03 ;WARD COLLECT ORDER ENTRY
WARDCOL ; EP
+1 IF $GET(SNAPSHOT)
DO ENTRYAUD^BLRUTIL("WARDCOL^LRORDGUI 0.0")
+2 SET %=1
+3 WRITE !,"Do you want copies of the orders"
DO YN^DICN
IF %=-1
QUIT
IF %=1
SET LRSLIP=""
IF %=0
DO QUIZ
GOTO WARDCOL
+4 ;IHS/OIRM TUC/AAB 2/13/97
IF $GET">GET(BLROPT)=""!($GET">GET(BLROPT(0))'=$PIECE(XQY0,U))
SET BLROPT="FASTORD"
SET BLROPT(0)=$PIECE(XQY0,U)
+5 SET LRORDR="WC"
DO LRORD
+6 QUIT
+7 ;
+8 ;
LEDI ; EP - Laboratory Electronic Data Exchange
+1 IF $GET(SNAPSHOT)
DO ENTRYAUD^BLRUTIL("LEDI^LRORDGUI 0.0")
+2 ; This entry point is used to select patients from ^LRT(67, file
+3 ; Routine LRDPAREF controls patient selection, patients must already
+4 ; exist in ^DPT in order to be selected.
+5 DO ^LRPARAM
+6 IF $GET(LREND)
DO ^LRORDK
QUIT
+7 ;
+8 NEW CONTROL,LA7,LA7SCFG,LA7X,LA7Y,LR64,LR696,LRLABLIO,LRRSTAT,LRRSITE,LRSD,LRTSN
+9 SET LRREFBAR=$$BAR^LA7SBCR
+10 IF LRREFBAR<0
DO ^LRORDK
QUIT
+11 ;
+12 SET LRRSTAT="I"
+13 SET LRRSTAT(0)=$$FIND1^DIC(64.061,"","OMX","Specimen in process","","I $P(^LAB(64.061,Y,0),U,7)=""U""")
+14 DO SITE^LA7SBCR2(.LRRSITE,"Scan Remote Site Barcode (SM)",LRREFBAR)
+15 IF LRRSITE("ERROR")
Begin DoDot:1
+16 WRITE !!,$CHAR(7),"ERROR -- ",$PIECE(LRRSITE("ERROR"),"^",2),!
+17 DO ^LRORDK
End DoDot:1
QUIT
+18 ;
+19 ; Get shipping manifest ID manual input
+20 IF $GET(LRRSITE("SMID"))=""
Begin DoDot:1
+21 FOR
DO SMID^LRORDB
IF LREND!($GET(LRRSITE("SMID"))'="")
QUIT
End DoDot:1
+22 IF $GET(LREND)
DO ^LRORDK
QUIT
+23 ;
+24 ; LRORDRR="R" variable indicates host accessioning of remote orders
+25 SET LRORDRR="R"
SET LRORDR=""
KILL LRODT
+26 DO LRORD
DO ^LRORDK
+27 IF $GET(SNAPSHOT)
DO ENTRYAUD^BLRUTIL("LEDI^LRORDGUI 9.0")
+28 QUIT
+29 ;
+30 ;
+31 ; LRORDRR =TYPE OF ORDER, LRECT =ASK COLECTION TIME
+32 ; LRFLOG =ACCESSION TEST GROUP, IF DEFINED ON ENTRY, PRESELECTS GROUP
+33 ;
QUIZ ; EP
+1 IF $GET(SNAPSHOT)
DO ENTRYAUD^BLRUTIL("QUIZ^LRORDGUI 0.0")
+2 WRITE !,"The order copy is automatically sent to the CLOSEST PRINTER,"
+3 WRITE !,"if a closest printer is defined for the device you are using."
+4 WRITE !,"Otherwise, you will be prompted with ORDER COPY DEVICE.",!
+5 QUIT
