BLROLOR ; IHS/MSC/MKK - Open Lab Orders Report ; 13-Oct-2017 14:04 ; MKK
;;5.2;LAB SERVICE;**1041**;NOV 1, 1997;Build 23
;
EEP ; Ersatz EP
D EEP^BLRGMENU
Q
;
;
EP ; EP
PEP ; EP
NEW (DILOCKTM,DISYS,DT,DTIME,DUZ,IO,IOBS,IOF,IOM,ION,IOS,IOSL,IOST,IOT,IOXY,U,XPARSYS,XQXFLG)
;
D SETBLRVS
;
D ADDTMENU^BLRGMENU("REPORT^BLROLOR","Report by Order Number")
D ADDTMENU^BLRGMENU("PROVRPT^BLROLOR","Report by Ordering Provider")
;
D MENUDRVR^BLRGMENU("RPMS Lab","Open Lab Orders Reports")
Q
;
;
REPORT ; EP - Main Report
NEW (DILOCKTM,DISYS,DT,DTIME,DUZ,IO,IOBS,IOF,IOM,ION,IOS,IOSL,IOST,IOT,IOXY,U,XPARSYS,XQXFLG)
;
Q:$$REPORTI("Order Number Sort")="Q"
;
F S ORDERN=$O(^LRO(69,"C",ORDERN)) Q:ORDERN<1!(QFLG="Q") D
. S CNTORD=CNTORD+1
. S (ACTUSER,LRASFND,LRODT)=0
. F S LRODT=$O(^LRO(69,"C",ORDERN,LRODT)) Q:LRODT<1!(QFLG="Q")!(LRASFND)!(ACTUSER) D
.. S LRSP=0
.. F S LRSP=$O(^LRO(69,"C",ORDERN,LRODT,LRSP)) Q:LRSP<1!(QFLG="Q")!(LRASFND)!(ACTUSER) D
... S LROIEN=LRSP_","_LRODT
... S ORDPROVI=$$GET1^DIQ(69.01,LROIEN,7,"I")
... I ORDPROVI="" S ACTUSER=1 Q
... ;
... S ACTUSER=$$ACTIVE^XUSER(ORDPROVI)
... Q:ACTUSER ; Skip if Active User
... ;
... S LROT=0
... F S LROT=$O(^LRO(69,LRODT,1,LRSP,2,LROT)) Q:LROT<1!(QFLG="Q")!(LRASFND) S LRASFND=$$LRASFND()
. ;
. Q:ACTUSER!(LRASFND) ; Skip if Active Provider OR Accession Number tied to Order
. ;
. S LRODT=0
. F S LRODT=$O(^LRO(69,"C",ORDERN,LRODT)) Q:LRODT<1!(QFLG="Q")!(ACTUSER) D
.. S LRSP=0
.. F S LRSP=$O(^LRO(69,"C",ORDERN,LRODT,LRSP)) Q:LRSP<1!(QFLG="Q")!(ACTUSER) D REPORTL
;
W !!,?4,CNTORD," Orders analyzed."
W !!,?9,CNT," Order",$$PLURAL(CNT)," with Non-Active Provider",$$PLURAL(CNT),"."
;
D ^%ZISC
;
I WOTDEV'["VT" D
. W !!,?4,CNTORD," Orders analyzed."
. W !!,?9,CNT," Orders with Non-Active Providers."
;
D PRESSKEY^BLRGMENU(4)
Q
;
REPORTI(HEDSUB2) ; EP - Initialization
D SETBLRVS
;
S HEADER(1)="Non-Accessioned Orders"
S HEADER(2)="With Non-Active Providers"
S HEADER(3)=$$CJ^XLFSTR(HEDSUB2,IOM)
;
D HEADERDT^BLRGMENU
D HEADONE^BLRGMENU(.HDRONE)
D HEADERDT^BLRGMENU
;
I HEDSUB2="Order Number Sort" D ^%ZIS D:'POP HEADERDT^BLRGMENU I POP Q $$BADSTUFQ("%ZIS Call Issue.")
;
D HEADERDT^BLRGMENU
;
S WOTDEV=IOST
;
S HEADER(4)=" "
S $E(HEADER(5),20)=$TR($$CJ^XLFSTR("@Ordering@Provider@",28)," @","= ")
S $E(HEADER(5),50)=$TR($$CJ^XLFSTR("@Patient@",31)," @","= ")
S HEADER(6)="Order #"
S $E(HEADER(6),10)="Ord Dt"
S $E(HEADER(6),20)="IEN"
S $E(HEADER(6),30)="Name"
S $E(HEADER(6),50)="IEN"
S $E(HEADER(6),60)="Name"
;
S MAXLINES=IOSL-4,LINES=MAXLINES+10
S (CNT,CNTORD,ORDERN,PG)=0,QFLG="NO"
U IO
Q "OK"
;
REPORTL ; EP - Line of Data
I LINES>MAXLINES D HEADERPG^BLRGMENU(.PG,.QFLG,HDRONE) Q:QFLG="Q"
;
D REPORTB
;
W ORDERN
W ?9,$$FMTE^XLFDT(ORDTT,"2DZ")
W ?19,ORDPROVI
W ?29,$E(ORDPROVN,1,18)
W ?49,DFN
W ?59,$E(PATNAME,1,21)
W !
S LINES=LINES+1
S CNT=CNT+1
Q
;
REPORTB ; EP - Break out Data
S LROIEN=LRSP_","_LRODT
S LRDFN=$$GET1^DIQ(69.01,LROIEN,.01,"I") ; Patient's Lab Number
S DFN=$$GET1^DIQ(63,LRDFN,.03,"I") ; Patient's File 2 IEN
S PATNAME=$$GET1^DIQ(2,DFN,.01) ; Patient's Name
S ORDTT=$$GET1^DIQ(69.01,LROIEN,5,"I") ; Ordering Date/Time
S ORDPROVI=$$GET1^DIQ(69.01,LROIEN,7,"I")
S ORDPROVN=$$GET1^DIQ(69.01,LROIEN,7) ; Ordering Provider
S ORDLOCI=$$GET1^DIQ(69.01,LROIEN,23,"I")
S ORDLOCN=$$GET1^DIQ(69.01,LROIEN,23) ; Ordering Location
Q
;
;
PROVRPT ; EP - Report by Ordering Provider
NEW (DILOCKTM,DISYS,DT,DTIME,DUZ,IO,IOBS,IOF,IOM,ION,IOS,IOSL,IOST,IOT,IOXY,U,XPARSYS,XQXFLG)
;
Q:$$REPORTI("Ordering Provider Sort")="Q"
;
K ^TMP("BLROLOR",$J)
;
W ?4,"Compiling"
F S ORDERN=$O(^LRO(69,"C",ORDERN)) Q:ORDERN<1!(QFLG="Q") D
. S CNTORD=CNTORD+1
. I (CNTORD#100)=0 W "." W:$X>74 !,?4
. S (ACTUSER,LRASFND,LRODT)=0
. K ORDPROV
. F S LRODT=$O(^LRO(69,"C",ORDERN,LRODT)) Q:LRODT<1!(QFLG="Q")!(LRASFND)!(ACTUSER) D
.. S LRSP=0
.. F S LRSP=$O(^LRO(69,"C",ORDERN,LRODT,LRSP)) Q:LRSP<1!(QFLG="Q")!(LRASFND)!(ACTUSER) D
... S LROIEN=LRSP_","_LRODT
... S ORDPROVI=$$GET1^DIQ(69.01,LROIEN,7,"I") ; Ordering Provider
... I ORDPROVI="" S ACTUSER=1 Q
... ;
... S ACTUSER=$$ACTIVE^XUSER(ORDPROVI)
... Q:ACTUSER ; Skip if Active User
... ;
... S ORDPROV($$GET1^DIQ(69.01,LROIEN,7),ORDPROVI,LRODT,LRSP)=ORDERN
... S LROT=0
... F S LROT=$O(^LRO(69,LRODT,1,LRSP,2,LROT)) Q:LROT<1!(QFLG="Q")!(LRASFND) S LRASFND=$$LRASFND()
. ;
. Q:ACTUSER!(LRASFND) ; Skip if Active Provider OR Accession Number tied to Order
. ;
. M ^TMP("BLROLOR",$J,"PROV")=ORDPROV
;
W !,?4,"Compilation Complete."
;
I $D(^TMP("BLROLOR",$J))<1 D ^%ZISC D BADSTUFF("No Open Lab Orders.") Q
;
D PRESSKEY^BLRGMENU(9)
;
D ^%ZIS
Q:POP $$BADSTUFQ("%ZIS Call Issue.")
S WOTDEV=IOST
U IO
S MAXLINES=IOSL-4,LINES=MAXLINES+10
;
S ORDPROVN=""
F S ORDPROVN=$O(^TMP("BLROLOR",$J,"PROV",ORDPROVN)) Q:ORDPROVN=""!(QFLG="Q") D
. S ORDPROVI=0
. F S ORDPROVI=$O(^TMP("BLROLOR",$J,"PROV",ORDPROVN,ORDPROVI)) Q:ORDPROVI<1!(QFLG="Q") D
.. S LRODT=0
.. F S LRODT=$O(^TMP("BLROLOR",$J,"PROV",ORDPROVN,ORDPROVI,LRODT)) Q:LRODT<1!(QFLG="Q") D
... S LRSP=0
... F S LRSP=$O(^TMP("BLROLOR",$J,"PROV",ORDPROVN,ORDPROVI,LRODT,LRSP)) Q:LRSP<1!(QFLG="Q") D
.... S ORDERN=$G(^TMP("BLROLOR",$J,"PROV",ORDPROVN,ORDPROVI,LRODT,LRSP))
.... D REPORTL
;
W !!,?4,CNTORD," Orders analyzed."
W !!,?9,CNT," Order",$$PLURAL(CNT)," with Non-Active Provider",$$PLURAL(CNT),"."
;
D ^%ZISC
;
I WOTDEV'["VT" D
. W !!,?4,CNTORD," Orders analyzed."
. W !!,?9,CNT," Order",$$PLURAL(CNT)," with Non-Active Provider",$$PLURAL(CNT),"."
;
D PRESSKEY^BLRGMENU(4)
Q
;
;
; ***************************** Utilities *****************************
;
JUSTNEW ; EP - Generic RPMS EXCLUSIVE NEW
NEW (DILOCKTM,DISYS,DT,DTIME,DUZ,IO,IOBS,IOF,IOM,ION,IOS,IOSL,IOST,IOT,IOXY,U,XPARSYS,XQXFLG)
;
Q
;
SETBLRVS(TWO) ; EP - Set the BLRVERN variable(s)
K BLRVERN,BLRVERN2
;
S BLRVERN=$P($P($T(+1),";")," ")
S:$L($G(TWO)) BLRVERN2=$G(TWO)
Q
;
BADSTUFF(STR,TAB) ; EP - BADSTUFF error message
S TAB=$S($L($G(TAB))<1:4,1:TAB)
W !!,?TAB,STR," Routine Ends."
D PRESSKEY^BLRGMENU(TAB+5)
Q
;
BADSTUFQ(STR,TAB) ; EP - BADSTUFF error message. Ends with Q "Q"uit
D BADSTUFF(STR,$G(TAB))
Q "Q"
;
PLURAL(CNT) ; EP - If CNT'=1, return S else return ""
Q $S(CNT=1:"",1:"s")
;
PLURALI(CNT) ; EP - If CNT'=1, return IES else return Y
Q $S(CNT=1:"y",1:"ies")
;
LRASFND() ; EP - Determine if order's Test has an accession attached to it
S LROTIEN=LROT_","_LRSP_","_LRODT
S LRAD=$$GET1^DIQ(69.03,LROTIEN,2,"I")
S LRAA=$$GET1^DIQ(69.03,LROTIEN,3,"I")
S LRAN=$$GET1^DIQ(69.03,LROTIEN,4,"I")
I LRAA!(LRAD)!(LRAN) Q 1
E Q 0
BLROLOR ; IHS/MSC/MKK - Open Lab Orders Report ; 13-Oct-2017 14:04 ; MKK
+1 ;;5.2;LAB SERVICE;**1041**;NOV 1, 1997;Build 23
+2 ;
EEP ; Ersatz EP
+1 DO EEP^BLRGMENU
+2 QUIT
+3 ;
+4 ;
EP ; EP
PEP ; EP
+1 NEW (DILOCKTM,DISYS,DT,DTIME,DUZ,IO,IOBS,IOF,IOM,ION,IOS,IOSL,IOST,IOT,IOXY,U,XPARSYS,XQXFLG)
+2 ;
+3 DO SETBLRVS
+4 ;
+5 DO ADDTMENU^BLRGMENU("REPORT^BLROLOR","Report by Order Number")
+6 DO ADDTMENU^BLRGMENU("PROVRPT^BLROLOR","Report by Ordering Provider")
+7 ;
+8 DO MENUDRVR^BLRGMENU("RPMS Lab","Open Lab Orders Reports")
+9 QUIT
+10 ;
+11 ;
REPORT ; EP - Main Report
+1 NEW (DILOCKTM,DISYS,DT,DTIME,DUZ,IO,IOBS,IOF,IOM,ION,IOS,IOSL,IOST,IOT,IOXY,U,XPARSYS,XQXFLG)
+2 ;
+3 IF $$REPORTI("Order Number Sort")="Q"
QUIT
+4 ;
+5 FOR
SET ORDERN=$ORDER(^LRO(69,"C",ORDERN))
IF ORDERN<1!(QFLG="Q")
QUIT
Begin DoDot:1
+6 SET CNTORD=CNTORD+1
+7 SET (ACTUSER,LRASFND,LRODT)=0
+8 FOR
SET LRODT=$ORDER(^LRO(69,"C",ORDERN,LRODT))
IF LRODT<1!(QFLG="Q")!(LRASFND)!(ACTUSER)
QUIT
Begin DoDot:2
+9 SET LRSP=0
+10 FOR
SET LRSP=$ORDER(^LRO(69,"C",ORDERN,LRODT,LRSP))
IF LRSP<1!(QFLG="Q")!(LRASFND)!(ACTUSER)
QUIT
Begin DoDot:3
+11 SET LROIEN=LRSP_","_LRODT
+12 SET ORDPROVI=$$GET1^DIQ(69.01,LROIEN,7,"I")
+13 IF ORDPROVI=""
SET ACTUSER=1
QUIT
+14 ;
+15 SET ACTUSER=$$ACTIVE^XUSER(ORDPROVI)
+16 ; Skip if Active User
IF ACTUSER
QUIT
+17 ;
+18 SET LROT=0
+19 FOR
SET LROT=$ORDER(^LRO(69,LRODT,1,LRSP,2,LROT))
IF LROT<1!(QFLG="Q")!(LRASFND)
QUIT
SET LRASFND=$$LRASFND()
End DoDot:3
End DoDot:2
+20 ;
+21 ; Skip if Active Provider OR Accession Number tied to Order
IF ACTUSER!(LRASFND)
QUIT
+22 ;
+23 SET LRODT=0
+24 FOR
SET LRODT=$ORDER(^LRO(69,"C",ORDERN,LRODT))
IF LRODT<1!(QFLG="Q")!(ACTUSER)
QUIT
Begin DoDot:2
+25 SET LRSP=0
+26 FOR
SET LRSP=$ORDER(^LRO(69,"C",ORDERN,LRODT,LRSP))
IF LRSP<1!(QFLG="Q")!(ACTUSER)
QUIT
DO REPORTL
End DoDot:2
End DoDot:1
+27 ;
+28 WRITE !!,?4,CNTORD," Orders analyzed."
+29 WRITE !!,?9,CNT," Order",$$PLURAL(CNT)," with Non-Active Provider",$$PLURAL(CNT),"."
+30 ;
+31 DO ^%ZISC
+32 ;
+33 IF WOTDEV'["VT"
Begin DoDot:1
+34 WRITE !!,?4,CNTORD," Orders analyzed."
+35 WRITE !!,?9,CNT," Orders with Non-Active Providers."
End DoDot:1
+36 ;
+37 DO PRESSKEY^BLRGMENU(4)
+38 QUIT
+39 ;
REPORTI(HEDSUB2) ; EP - Initialization
+1 DO SETBLRVS
+2 ;
+3 SET HEADER(1)="Non-Accessioned Orders"
+4 SET HEADER(2)="With Non-Active Providers"
+5 SET HEADER(3)=$$CJ^XLFSTR(HEDSUB2,IOM)
+6 ;
+7 DO HEADERDT^BLRGMENU
+8 DO HEADONE^BLRGMENU(.HDRONE)
+9 DO HEADERDT^BLRGMENU
+10 ;
+11 IF HEDSUB2="Order Number Sort"
DO ^%ZIS
IF 'POP
DO HEADERDT^BLRGMENU
IF POP
QUIT $$BADSTUFQ("%ZIS Call Issue.")
+12 ;
+13 DO HEADERDT^BLRGMENU
+14 ;
+15 SET WOTDEV=IOST
+16 ;
+17 SET HEADER(4)=" "
+18 SET $EXTRACT(HEADER(5),20)=$TRANSLATE($$CJ^XLFSTR("@Ordering@Provider@",28)," @","= ")
+19 SET $EXTRACT(HEADER(5),50)=$TRANSLATE($$CJ^XLFSTR("@Patient@",31)," @","= ")
+20 SET HEADER(6)="Order #"
+21 SET $EXTRACT(HEADER(6),10)="Ord Dt"
+22 SET $EXTRACT(HEADER(6),20)="IEN"
+23 SET $EXTRACT(HEADER(6),30)="Name"
+24 SET $EXTRACT(HEADER(6),50)="IEN"
+25 SET $EXTRACT(HEADER(6),60)="Name"
+26 ;
+27 SET MAXLINES=IOSL-4
SET LINES=MAXLINES+10
+28 SET (CNT,CNTORD,ORDERN,PG)=0
SET QFLG="NO"
+29 USE IO
+30 QUIT "OK"
+31 ;
REPORTL ; EP - Line of Data
+1 IF LINES>MAXLINES
DO HEADERPG^BLRGMENU(.PG,.QFLG,HDRONE)
IF QFLG="Q"
QUIT
+2 ;
+3 DO REPORTB
+4 ;
+5 WRITE ORDERN
+6 WRITE ?9,$$FMTE^XLFDT(ORDTT,"2DZ")
+7 WRITE ?19,ORDPROVI
+8 WRITE ?29,$EXTRACT(ORDPROVN,1,18)
+9 WRITE ?49,DFN
+10 WRITE ?59,$EXTRACT(PATNAME,1,21)
+11 WRITE !
+12 SET LINES=LINES+1
+13 SET CNT=CNT+1
+14 QUIT
+15 ;
REPORTB ; EP - Break out Data
+1 SET LROIEN=LRSP_","_LRODT
+2 ; Patient's Lab Number
SET LRDFN=$$GET1^DIQ(69.01,LROIEN,.01,"I")
+3 ; Patient's File 2 IEN
SET DFN=$$GET1^DIQ(63,LRDFN,.03,"I")
+4 ; Patient's Name
SET PATNAME=$$GET1^DIQ(2,DFN,.01)
+5 ; Ordering Date/Time
SET ORDTT=$$GET1^DIQ(69.01,LROIEN,5,"I")
+6 SET ORDPROVI=$$GET1^DIQ(69.01,LROIEN,7,"I")
+7 ; Ordering Provider
SET ORDPROVN=$$GET1^DIQ(69.01,LROIEN,7)
+8 SET ORDLOCI=$$GET1^DIQ(69.01,LROIEN,23,"I")
+9 ; Ordering Location
SET ORDLOCN=$$GET1^DIQ(69.01,LROIEN,23)
+10 QUIT
+11 ;
+12 ;
PROVRPT ; EP - Report by Ordering Provider
+1 NEW (DILOCKTM,DISYS,DT,DTIME,DUZ,IO,IOBS,IOF,IOM,ION,IOS,IOSL,IOST,IOT,IOXY,U,XPARSYS,XQXFLG)
+2 ;
+3 IF $$REPORTI("Ordering Provider Sort")="Q"
QUIT
+4 ;
+5 KILL ^TMP("BLROLOR",$JOB)
+6 ;
+7 WRITE ?4,"Compiling"
+8 FOR
SET ORDERN=$ORDER(^LRO(69,"C",ORDERN))
IF ORDERN<1!(QFLG="Q")
QUIT
Begin DoDot:1
+9 SET CNTORD=CNTORD+1
+10 IF (CNTORD#100)=0
WRITE "."
IF $X>74
WRITE !,?4
+11 SET (ACTUSER,LRASFND,LRODT)=0
+12 KILL ORDPROV
+13 FOR
SET LRODT=$ORDER(^LRO(69,"C",ORDERN,LRODT))
IF LRODT<1!(QFLG="Q")!(LRASFND)!(ACTUSER)
QUIT
Begin DoDot:2
+14 SET LRSP=0
+15 FOR
SET LRSP=$ORDER(^LRO(69,"C",ORDERN,LRODT,LRSP))
IF LRSP<1!(QFLG="Q")!(LRASFND)!(ACTUSER)
QUIT
Begin DoDot:3
+16 SET LROIEN=LRSP_","_LRODT
+17 ; Ordering Provider
SET ORDPROVI=$$GET1^DIQ(69.01,LROIEN,7,"I")
+18 IF ORDPROVI=""
SET ACTUSER=1
QUIT
+19 ;
+20 SET ACTUSER=$$ACTIVE^XUSER(ORDPROVI)
+21 ; Skip if Active User
IF ACTUSER
QUIT
+22 ;
+23 SET ORDPROV($$GET1^DIQ(69.01,LROIEN,7),ORDPROVI,LRODT,LRSP)=ORDERN
+24 SET LROT=0
+25 FOR
SET LROT=$ORDER(^LRO(69,LRODT,1,LRSP,2,LROT))
IF LROT<1!(QFLG="Q")!(LRASFND)
QUIT
SET LRASFND=$$LRASFND()
End DoDot:3
End DoDot:2
+26 ;
+27 ; Skip if Active Provider OR Accession Number tied to Order
IF ACTUSER!(LRASFND)
QUIT
+28 ;
+29 MERGE ^TMP("BLROLOR",$JOB,"PROV")=ORDPROV
End DoDot:1
+30 ;
+31 WRITE !,?4,"Compilation Complete."
+32 ;
+33 IF $DATA(^TMP("BLROLOR",$JOB))<1
DO ^%ZISC
DO BADSTUFF("No Open Lab Orders.")
QUIT
+34 ;
+35 DO PRESSKEY^BLRGMENU(9)
+36 ;
+37 DO ^%ZIS
+38 IF POP
QUIT $$BADSTUFQ("%ZIS Call Issue.")
+39 SET WOTDEV=IOST
+40 USE IO
+41 SET MAXLINES=IOSL-4
SET LINES=MAXLINES+10
+42 ;
+43 SET ORDPROVN=""
+44 FOR
SET ORDPROVN=$ORDER(^TMP("BLROLOR",$JOB,"PROV",ORDPROVN))
IF ORDPROVN=""!(QFLG="Q")
QUIT
Begin DoDot:1
+45 SET ORDPROVI=0
+46 FOR
SET ORDPROVI=$ORDER(^TMP("BLROLOR",$JOB,"PROV",ORDPROVN,ORDPROVI))
IF ORDPROVI<1!(QFLG="Q")
QUIT
Begin DoDot:2
+47 SET LRODT=0
+48 FOR
SET LRODT=$ORDER(^TMP("BLROLOR",$JOB,"PROV",ORDPROVN,ORDPROVI,LRODT))
IF LRODT<1!(QFLG="Q")
QUIT
Begin DoDot:3
+49 SET LRSP=0
+50 FOR
SET LRSP=$ORDER(^TMP("BLROLOR",$JOB,"PROV",ORDPROVN,ORDPROVI,LRODT,LRSP))
IF LRSP<1!(QFLG="Q")
QUIT
Begin DoDot:4
+51 SET ORDERN=$GET(^TMP("BLROLOR",$JOB,"PROV",ORDPROVN,ORDPROVI,LRODT,LRSP))
+52 DO REPORTL
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+53 ;
+54 WRITE !!,?4,CNTORD," Orders analyzed."
+55 WRITE !!,?9,CNT," Order",$$PLURAL(CNT)," with Non-Active Provider",$$PLURAL(CNT),"."
+56 ;
+57 DO ^%ZISC
+58 ;
+59 IF WOTDEV'["VT"
Begin DoDot:1
+60 WRITE !!,?4,CNTORD," Orders analyzed."
+61 WRITE !!,?9,CNT," Order",$$PLURAL(CNT)," with Non-Active Provider",$$PLURAL(CNT),"."
End DoDot:1
+62 ;
+63 DO PRESSKEY^BLRGMENU(4)
+64 QUIT
+65 ;
+66 ;
+67 ; ***************************** Utilities *****************************
+68 ;
JUSTNEW ; EP - Generic RPMS EXCLUSIVE NEW
+1 NEW (DILOCKTM,DISYS,DT,DTIME,DUZ,IO,IOBS,IOF,IOM,ION,IOS,IOSL,IOST,IOT,IOXY,U,XPARSYS,XQXFLG)
+2 ;
+3 QUIT
+4 ;
SETBLRVS(TWO) ; EP - Set the BLRVERN variable(s)
+1 KILL BLRVERN,BLRVERN2
+2 ;
+3 SET BLRVERN=$PIECE($PIECE($TEXT(+1),";")," ")
+4 IF $LENGTH($GET(TWO))
SET BLRVERN2=$GET(TWO)
+5 QUIT
+6 ;
BADSTUFF(STR,TAB) ; EP - BADSTUFF error message
+1 SET TAB=$SELECT($LENGTH($GET(TAB))<1:4,1:TAB)
+2 WRITE !!,?TAB,STR," Routine Ends."
+3 DO PRESSKEY^BLRGMENU(TAB+5)
+4 QUIT
+5 ;
BADSTUFQ(STR,TAB) ; EP - BADSTUFF error message. Ends with Q "Q"uit
+1 DO BADSTUFF(STR,$GET(TAB))
+2 QUIT "Q"
+3 ;
PLURAL(CNT) ; EP - If CNT'=1, return S else return ""
+1 QUIT $SELECT(CNT=1:"",1:"s")
+2 ;
PLURALI(CNT) ; EP - If CNT'=1, return IES else return Y
+1 QUIT $SELECT(CNT=1:"y",1:"ies")
+2 ;
LRASFND() ; EP - Determine if order's Test has an accession attached to it
+1 SET LROTIEN=LROT_","_LRSP_","_LRODT
+2 SET LRAD=$$GET1^DIQ(69.03,LROTIEN,2,"I")
+3 SET LRAA=$$GET1^DIQ(69.03,LROTIEN,3,"I")
+4 SET LRAN=$$GET1^DIQ(69.03,LROTIEN,4,"I")
+5 IF LRAA!(LRAD)!(LRAN)
QUIT 1
+6 IF '$TEST
QUIT 0
