- 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
