Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: BLR7OB1

BLR7OB1.m

Go to the documentation of this file. 
  1. BLR7OB1 ; IHS/MSC/MKK - Update an Order's OERR Status Flag ; 16-Jul-2015 06:30 ; MKK
  1.  ;;5.2;LAB SERVICE;**1035**;NOV 01, 1997;Build 5
  1.  ;
  1. EEP ; Ersatz EP
  1.  D EEP^BLRGMENU
  1.  Q
  1.  ;
  1.  ; In LR*5.2*1033, when an order is cancelled during the Clinical Indication process, the
  1.  ; the OERR status is *NOT* updated.  This routine was written to correct those orders.
  1.  ;
  1. EP ; EP
  1. PEP ; EP
  1.  NEW (DILOCKTM,DISYS,DT,DTIME,DUZ,IO,IOBS,IOF,IOM,ION,IOS,IOSL,IOST,IOT,IOXY,U,XPARSYS,XQXFLG)
  1.  ;
  1.  D SETBLRVS
  1.  ;
  1.  Q:$$CHEKUSER()="Q"
  1.  ;
  1.  D ADDTMENU^BLRGMENU("OERRFIX^BLR7OB1","Update an Order's OERR Status")
  1.  D ADDTMENU^BLRGMENU("ROERRSTS^BLR7OB1","Report on Orders OERR Status")
  1.  D ADDTMENU^BLRGMENU("OERRAFIX^BLR7OB1","Update All Orders' OERR Status")
  1.  ;
  1.  ; Main Menu driver
  1.  D MENUDRVR^BLRGMENU("RPMS Lab","Lab Order OERR Status Utilities")
  1.  Q
  1.  ;
  1.  ;
  1. OERRFIX ; EP - Update an Order's OERR Status Flag - Interactive version
  1.  NEW (DILOCKTM,DISYS,DT,DTIME,DUZ,IO,IOBS,IOF,IOM,ION,IOS,IOSL,IOST,IOT,IOXY,U,XPARSYS,XQXFLG)
  1.  ;
  1.  D SETBLRVS("OERRFIX")
  1.  ;
  1.  S HEADER(1)="Fix A Cancelled Order's OERR PENDING Status"
  1.  ;
  1.  S ONGO="YES"
  1.  F  Q:ONGO'="YES"  D
  1.  . D HEADERDT^BLRGMENU
  1.  . D ^XBFMK
  1.  . S DIR(0)="PO^69:EMZ"
  1.  . D ^DIR
  1.  . I +X<1!(+$G(DIRUT)) S ONGO="NO"  Q
  1.  . I $D(^LRO(69,"C",+X))<1  D BADSTUF2^BLRUTIL7("Order "_+X_" Not in File 69.  Try again.")  Q
  1.  . ;
  1.  . D FIXIT(+X)
  1.  . F X=2:1:4  K HEADER(X)
  1.  ;
  1.  Q
  1.  ;
  1.  ;
  1. FIXIT(ORDERN) ; EP - Fix the OERR Order
  1.  D RESETHDR(ORDERN)
  1.  ;
  1.  D HEADERDT^BLRGMENU
  1.  D SHOWOERR("BEFORE",ORDERN)
  1.  ;
  1.  S (CNT,LRODT)=0
  1.  F  S LRODT=$O(^LRO(69,"C",ORDERN,LRODT))  Q:LRODT<1  D
  1.  . S LRSP=0
  1.  . F  S LRSP=$O(^LRO(69,"C",ORDERN,LRODT,LRSP))  Q:LRSP<1  D
  1.  .. S (OKAY,LROT)=0
  1.  .. F  S LROT=$O(^LRO(69,LRODT,1,LRSP,2,LROT))  Q:LROT<1  D
  1.  ... S TORDIEN=LROT_","_LRSP_","_LRODT
  1.  ... S CANCLRSN=$$GET1^DIQ(69.3991,1_","_TORDIEN,.01)
  1.  ... Q:CANCLRSN'["Clinical Indication"
  1.  ... ;
  1.  ... S F60IEN=$$GET1^DIQ(69.03,TORDIEN,.01,"I")
  1.  ... Q:F60IEN<1
  1.  ... ;
  1.  ... S TOERRIEN=+$$GET1^DIQ(69.03,TORDIEN,6)
  1.  ... S TOERRSTS=$$GET1^DIQ(100,TOERRIEN,5)
  1.  ... Q:TOERRSTS'["PEND"
  1.  ... ;
  1.  ... S TESTS(F60IEN)=""
  1.  ... S OKAY=OKAY+1
  1.  ... S CNT=CNT+1
  1.  .. Q:OKAY<1
  1.  .. ;
  1.  .. D NEW(LRODT,LRSP,"OC",,.TESTS,1)
  1.  ;
  1.  I CNT<1 D BADSTUF2^BLRUTIL7("Order "_ORDERN_" has no 'Deleted' Test(s) with OERR Status = PENDING.",10)  Q
  1.  ;
  1.  D SHOWOERR("AFTER",ORDERN)
  1.  D PRESSKEY^BLRGMENU(4)
  1.  Q
  1.  ;
  1.  ;
  1. RESETHDR(ORDERN) ; EP - Create rest of HEADER array
  1.  S HEADER(2)="Order #:"_ORDERN
  1.  S HEADER(3)=" "
  1.  S $E(HEADER(4),15)="F60IEN"
  1.  S $E(HEADER(4),25)="F60 Description"
  1.  S $E(HEADER(4),55)="OERR #"
  1.  S $E(HEADER(4),65)="OERR Status"
  1.  Q
  1.  ;
  1.  ;
  1. SHOWOERR(MSG,ORDERN) ; EP - Show the Status of OERR Numbers
  1.  NEW F60DESC,F60IEN,LRODT,LRSP,LROT,OERRNUM,OERRSTS
  1.  ;
  1.  S LRODT=0
  1.  F  S LRODT=$O(^LRO(69,"C",ORDERN,LRODT))  Q:LRODT<1  D
  1.  . S LRSP=0
  1.  . F  S LRSP=$O(^LRO(69,"C",ORDERN,LRODT,LRSP))  Q:LRSP<1  D
  1.  .. S LROT=0
  1.  .. F  S LROT=$O(^LRO(69,LRODT,1,LRSP,2,LROT))  Q:LROT<1  D
  1.  ... S TORDIEN=LROT_","_LRSP_","_LRODT
  1.  ... S F60IEN=$$GET1^DIQ(69.03,TORDIEN,.01,"I")
  1.  ... S F60DESC=$$GET1^DIQ(69.03,TORDIEN,.01)
  1.  ... S OERRNUM=$$GET1^DIQ(69.03,TORDIEN,6)
  1.  ... S OERRSTS=$$GET1^DIQ(100,+OERRNUM,5)
  1.  ... W ?4,MSG,?14,F60IEN,?24,$E(F60DESC,1,28),?54,OERRNUM,?64,OERRSTS,!
  1.  Q
  1.  ;
  1.  ;
  1. OERRAFIX ; EP - Update all Orders' OERR Status Flag - Interactive version
  1.  NEW (DILOCKTM,DISYS,DT,DTIME,DUZ,IO,IOBS,IOF,IOM,ION,IOS,IOSL,IOST,IOT,IOXY,U,XPARSYS,XQXFLG)
  1.  ;
  1.  D SETBLRVS("OERRAFIX")
  1.  ;
  1.  S HEADER(1)="OERR Order Status Update"
  1.  S HEADER(2)="Cancelled Orders Only"
  1.  D HEADERDT^BLRGMENU
  1.  ;
  1.  ;          1         2         3         4         5         6         7
  1.  ;     567890123456789012345678901234567890123456789012345678901234567890
  1.  W ?9,"This routine will UPDATE the OERR Order status for ALL Lab",!
  1.  W ?4,"Orders that were cancelled during the Clinical Indication process",!
  1.  W ?4,"prior to the installation of the LR*5.2*1035 patch.",!!
  1.  I $D(^XTMP("BLR7OB1")) D
  1.  . W ?9,"The LR*5.2*1035 Patch's Post Install Routine ran this on ",!
  1.  . W ?19,$$FMTE^XLFDT($P($G(^XTMP("BLR7OB1",0)),U),"5DZ"),!!
  1.  W ?9,"This should only need to be run once.",!!
  1.  W ?9,"NOTE: this could take a long time to run.",!
  1.  ;
  1.  Q:$$WARNINGS^BLROTSCH("Are you sure you want to do this",9)="Q"
  1.  ;
  1.  D HEADERDT^BLRGMENU
  1.  Q:$$WARNINGS^BLROTSCH("Second Chance: Are you still sure you want to do this",9)="Q"
  1.  ;
  1.  D HEADERDT^BLRGMENU
  1.  Q:$$WARNINGS^BLROTSCH("LAST CHANCE: Do you want to do this",9)="Q"
  1.  ;
  1.  W !!,?4,"Very well."
  1.  D PRESSKEY^BLRGMENU(9)
  1.  ;
  1.  D HEADERDT^BLRGMENU
  1.  D OERRSTSC
  1.  ;
  1.  D PRESSKEY^BLRGMENU(4)
  1.  Q
  1.  ;
  1.  ;
  1.  ; The following is called from the BLRPRE35 routine during Post Install processing OR from OERRAFIX above.
  1. OERRSTSC ; EP - Change OERR Status for All OERR Orders with PENDING Status after associated Lab Order was cancelled during the Clinical Indication process.
  1.  NEW (DILOCKTM,DISYS,DT,DTIME,DUZ,IO,IOBS,IOF,IOM,ION,IOS,IOSL,IOST,IOT,IOXY,U,XPARSYS,XQXFLG)
  1.  ;
  1.  D TABMESG^BLRKIDSU("Modify OERR Status for Orders Cancelled During Clinical Indication.",5)
  1.  ;
  1.  D FIND^DIC(9.7,,"17I",,"LR*5.2*1033",,,,,"TARGET","ERRS") ; Need to determine when LR*5.2*1033 installed.
  1.  I $D(ERRS) D  Q
  1.  . D TABMESG^BLRKIDSU("Could not determine when LR*5.2*1033 was First Installed.",10)
  1.  ;
  1.  S LR1033ID=$G(TARGET("DILIST","ID",1,17))  ; Use LR*5.2*1033 first Install Date
  1.  D BOKAY^BLRKIDS2("LR*5.2*1033 First Installed "_$$FMTE^XLFDT(LR1033ID,"5MZ")_".",10)
  1.  ; 
  1.  S (CNT,CNTORD)=0
  1.  S LRODT=$$FMADD^XLFDT($P(LR1033ID,"."),-2)
  1.  F  S LRODT=$O(^LRO(69,LRODT))  Q:LRODT<1  D
  1.  . S LRSP=0
  1.  . F  S LRSP=$O(^LRO(69,LRODT,1,LRSP))  Q:LRSP<1  D
  1.  .. S CNTORD=CNTORD+1
  1.  .. S (FOUND,LROT)=0
  1.  .. F  S LROT=$O(^LRO(69,LRODT,1,LRSP,2,LROT))  Q:LROT<1  D
  1.  ... S LROTIEN=LROT_","_LRSP_","_LRODT
  1.  ... S CANCELR=$$GET1^DIQ(69.3991,1_","_LROTIEN,.01)  ; Get Cancel Reason
  1.  ... Q:CANCELR'["Clinical Indication"       ; Skip if no "Clinical Indication" string
  1.  ... ;
  1.  ... S LROTOERR=$$GET1^DIQ(69.03,LROTIEN,6)
  1.  ... Q:LROTOERR<1                           ; Skip if no OERR number
  1.  ... Q:$$GET1^DIQ(100,LROTOERR,5)'["PEND"   ; Skip if OERR entry not PENDING
  1.  ... ;
  1.  ... S F60IEN=$$GET1^DIQ(69.03,LROTIEN,.01,"I")
  1.  ... Q:F60IEN<1                             ; Skip if no File 60 IEN
  1.  ... ;
  1.  ... S TESTS(F60IEN)=""
  1.  ... S FOUND=FOUND+1
  1.  .. ;
  1.  .. Q:FOUND<1      ; Skip if Order Not Cancelled or if OERR Status for tests not PENDING
  1.  .. ;
  1.  .. D NEW^BLR7OB1(LRODT,LRSP,"OC",,.TESTS,1)
  1.  .. S CNT=CNT+1
  1.  .. S ^XTMP("BLR7OB1",$J,"OERRSTSC",LRODT,LRSP)=""
  1.  ;
  1.  D TABMESG^BLRKIDSU(CNTORD_" Lab Orders analyzed.",4)
  1.  D MES^XPDUTL
  1.  D TABMESG^BLRKIDSU($S(CNT:CNT,1:"No")_" Lab Orders with OERR PENDING status.",9)
  1.  ;
  1.  Q:CNT<1
  1.  ;
  1.  S ^XTMP("BLR7OB1",0)=$$HTFM^XLFDT(+$H+90)_"^"_$$DT^XLFDT_"^Cancelled Orders OERR PENDING status Changed"
  1.  ;
  1.  D BOKAY^BLRPRE31(CNT_" Cancelled Orders OERR PENDING status changed to DISCONTINUED.",9)
  1.  Q
  1.  ;
  1.  ;
  1.  ; Bits and pieces cloned from LR7OB1, LR7OB0, LR7OB3, and LR7OB69
  1. NEW(ODT,SN,CONTROL,NAT,TESTS,LRSTATI) ; Set-up order message - Cloned from LR7OB1
  1.  Q:'$L($T(MSG^XQOR))
  1.  Q:'$D(^LRO(69,$G(ODT),1,$G(SN),0))  N LRX0 S LRX0=^(0)
  1.  ;
  1.  I $$VER^LR7OU1>2.5,'$G(^ORD(100.99,1,"CONV")) N Y,DFN,LRDPF S Y=$G(^LR(+LRX0,0)),DFN=$P(Y,"^",3),LRDPF=$P(Y,"^",2)_$G(^DIC(+$P(Y,"^",2),0,"GL")) D
  1.  . Q:'$D(^ORD(100.99,1,"PTCONV",DFN))
  1.  . S $P(^LRO(69,ODT,1,SN,0),"^",11)=1  ; Keeps this order from being converted
  1.  . D EN^LR7OV2(DFN_";"_$P(LRDPF,"^",2),1)
  1.  Q:$P($G(^LR(+LRX0,0)),"^",2)'=2       ; Only allow messages for patients (file 2)
  1.  N MSG,ORCHMSG,ORBBMSG,ORAPMSG,I,LRNIFN,LRTMPO
  1.  K ^TMP("LRAP",$J),^TMP("LRCH",$J),^TMP("LRBB",$J)
  1.  D ORD1^LR7OB1(ODT,SN,.TESTS)
  1.  I '$D(LRTMPO("LRIFN")) D EN1^LR7OB0(ODT,SN,CONTROL,$G(NAT)),CALL^LR7OB1(CONTROL) K ^TMP("LRAP",$J),^TMP("LRCH",$J),^TMP("LRBB",$J) Q
  1.  NEW TSTARRAY
  1.  S LRNIFN=0 F  S LRNIFN=$O(LRTMPO("LRIFN",LRNIFN)) Q:LRNIFN<1  S X=LRTMPO("LRIFN",LRNIFN) D
  1.  . I $P(X,"^",7)="P" Q  ;Test purged from CPRS
  1.  . I $L($P(X,"^",14)) N ODT,SN D  Q
  1.  .. S ODT=+$P(X,"^",14),SN=$P($P(X,"^",14),";",2)
  1.  .. I $D(^LRO(69,+ODT,1,+SN,0)) S:CONTROL="RE" LRSTATI=2 D EN1^LR7OB0(ODT,SN,CONTROL,$G(NAT)),CALL^LR7OB1(CONTROL) K ^TMP("LRAP",$J),^TMP("LRCH",$J),^TMP("LRBB",$J)
  1.  . ; D EN1^LR7OB0(ODT,SN,CONTROL,$G(NAT)),CALL(CONTROL) K ^TMP("LRAP",$J),^TMP("LRCH",$J),^TMP("LRBB",$J)
  1.  . D EN1(ODT,SN,CONTROL,$G(NAT))
  1.  . I $D(^TMP("LRCH",$J)) K TSTARRAY  M TSTARRAY=^TMP("LRCH",$J)
  1.  . D ENTRYAUD^BLRUTIL("NEW^LR7OB1 8.5","TSTARRAY")    ; DEBUG
  1.  . D CALL^LR7OB1(CONTROL) K ^TMP("LRAP",$J),^TMP("LRCH",$J),^TMP("LRBB",$J)
  1.  Q
  1.  ;
  1.  ;
  1. EN1(ODT,SN,CONTROL,NAT) ; EP - Build msg based on date and LRSN - Cloned from LR7OB0
  1.  ;See doc under EN.
  1.  ;SN=Specimen # in ^LRO(69,ODT,SN,
  1.  N I,J,D0,DR,DA,DIC,DIE,CAT,ROOM,LOC,VAIN,VAERR,STDT,X,CTR,IFN,IFN1,IFN2,Z,Z1,LOC,X1,X2,X3,X4,X5,X6,X7,X8,X9,X10,Y10,Y,COBR,COBX,DFN,LRDPF,LRDFN,LRFIRST,SEX,ORCMSG,OBRMSG,MSG,CHMSG,BBMSG,APMSG
  1.  K ^TMP("LRX",$J)
  1.  S LRFIRST=1,MSG="" D B369
  1.  Q
  1.  ;
  1.  ;
  1. B369 ; EP - Cloned from LR7OB3
  1.  K ^TMP("LRX",$J)
  1.  D 69(ODT,SN) Q:'$D(^TMP("LRX",$J,69))  G OUT:'$D(DFN) D:LRFIRST FIRST^LR7OB0 S LRFIRST=0
  1.  D SNEAK^LR7OB3
  1.  Q
  1.  ;
  1.  ;
  1. OUT ;Exit here
  1.  K ^TMP("LRX",$J)
  1.  Q
  1.  ;
  1.  ;
  1. 69(ODT,SN) ; Cloned from LR7OB69.  See Documentation in that routine.
  1.  N X,X0,XP1,X1,X4,Y1,Y2,Y3,Y4,Y5,Y6,Y7,Y8,Y9,Y10,Y11,Y12,IFN,TSTY,NOTE,GOTCOM K ^TMP("LRX",$J,69)
  1.  Q:'$D(^LRO(69,+ODT,1,+SN,0))  S X0=^(0),XP1=$G(^(.1)),X1=$G(^(1)),X3=$G(^(3)),X4=$O(^(4,0))
  1.  Q:'$D(^LR(+X0,0))  ;No matching entry in ^LR
  1.  S:'$D(DFN) DFN=$P(^LR(+X0,0),"^",3) S:'$D(LRDFN) LRDFN=+X0 S:'$D(LRDPF) LRDPF=$P(^LR(+X0,0),"^",2)_$G(^DIC(+$P(^LR(+X0,0),"^",2),0,"GL"))
  1.  S Y1=+XP1,Y2=$S($P(X1,"^"):$P(X1,"^"),1:$P(X0,"^",8)),Y3=$P(X0,"^",3),Y4=$P(X0,"^",4),Y5=$P(X0,"^",5),Y6=$P(X0,"^",6),Y7=$P(X0,"^",9),Y8=$P(X3,"^"),Y9=$P(X3,"^",2),Y11=$P(X0,"^",11),Y12=$P(X0,"^",2)
  1.  S IFN=0 F  S IFN=$O(^LRO(69,ODT,1,SN,2,IFN)) Q:IFN<1  S X=$G(^(IFN,0)) I X D
  1.  . I $G(LRNIFN),$D(LRTMPO("LRIFN",LRNIFN)) Q:+X'=+LRTMPO("LRIFN",LRNIFN)
  1.  . S ^TMP("LRX",$J,69,IFN)=X,I=0
  1.  . D GDG1^LRBEBA2(ODT,SN,IFN)
  1.  . F  S I=$O(^LRO(69,ODT,1,SN,2,IFN,1,I)) Q:I<1  S X=^(I,0) D
  1.  .. S ^TMP("LRX",$J,69,IFN,"N",I)=X
  1.  . S I=0 F  S I=$O(^LRO(69,ODT,1,SN,2,IFN,1.1,I)) Q:I<1  S X=^(I,0) D
  1.  .. S ^TMP("LRX",$J,69,IFN,"NC",I)=X
  1.  S IFN=0 F  S IFN=$O(^LRO(69,ODT,1,SN,6,IFN)) Q:IFN<1  S X=^(IFN,0) D
  1.  . Q:X["removed ==>"  Q:X["deleted by"
  1.  . S ^TMP("LRX",$J,69,"N",IFN)=X
  1.  S Y10=$O(^LRO(69,ODT,1,SN,4,0)),Y10=$S(Y10:$P(^(Y10,0),"^"),1:"")
  1.  S ^TMP("LRX",$J,69)=Y1_"^"_Y2_"^"_Y3_"^"_Y4_"^"_Y5_"^"_Y6_"^"_Y7_"^"_Y8_"^"_Y9_"^"_Y10_"^"_Y11_"^"_Y12
  1.  S IFN=0 F  S IFN=$O(^TMP("LRX",$J,69,IFN)) Q:IFN<1  S X=^TMP("LRX",$J,69,IFN) S X1=$P(X,"^",3),X2=$P(X,"^",4),X3=$P(X,"^",5) K TSTY D EN^LR7OU1(+X,$P(^LAB(60,+X,0),"^",5)) D 68^LR7OB68(IFN,X1,X2,X3,+X)
  1.  Q
  1.  ;
  1.  ;
  1. ROERRSTS ; EP - Report on pending OERR STatuS for orders deleted during the clinical indication process.
  1.  NEW (DILOCKTM,DISYS,DT,DTIME,DUZ,IO,IOBS,IOF,IOM,ION,IOS,IOSL,IOST,IOT,IOXY,U,XPARSYS,XQXFLG)
  1.  ;
  1.  Q:$$ROERRSTI()="Q"
  1.  ;
  1.  F  S LRODT=$O(^LRO(69,LRODT))  Q:LRODT<1!(QFLG="Q")  D
  1.  . S LRSP=0
  1.  . F  S LRSP=$O(^LRO(69,LRODT,1,LRSP))  Q:LRSP<1!(QFLG="Q")  D
  1.  .. D ORDLVLDA
  1.  .. S LROT=0
  1.  .. F  S LROT=$O(^LRO(69,LRODT,1,LRSP,2,LROT))  Q:LROT<1!(QFLG="Q")  D ROERRSTL
  1.  ;
  1.  W:CNT !!
  1.  W ?4,ORDERCNT," Lab Order Entry (#69) File entries analyzed."
  1.  W !!,?9,$S(CNT:CNT,1:"No")," Order",$S(CNT=1:"",1:"s")," with PENDING OERR status."
  1.  D PRESSKEY^BLRGMENU(4)
  1.  Q
  1.  ;
  1. ROERRSTI() ; EP - Initialization
  1.  D SETBLRVS("ROERRSTS")
  1.  S HEADER(1)="Orders Cancelled During Clinical Indication"
  1.  S HEADER(2)="PENDING OERR Status"
  1.  ;
  1.  D FIND^DIC(9.7,,"17I",,"LR*5.2*1033",,,,,"TARGET","ERRS") ; Need to determine when LR*5.2*1033 installed.
  1.  Q:$D(ERRS) $$BADSTF2Q^BLRUTIL7("LR*5.2*1033 Install Date NOT FOUND.")
  1.  ;
  1.  S LR1033ID=$G(TARGET("DILIST","ID",1,17))  ; Use LR*5.2*1033 first Install Date
  1.  S HEADER(3)=$$CJ^XLFSTR("LR*5.2*1033 Installed:"_$$FMTE^XLFDT(LR1033ID,"5DZ"),IOM)
  1.  ;
  1.  D HEADERDT^BLRGMENU
  1.  D HEADONE^BLRGMENU(.HDRONE)
  1.  D HEADERDT^BLRGMENU
  1.  ;
  1.  S HEADER(4)=" "
  1.  S $E(HEADER(5),10)="External"
  1.  S $E(HEADER(5),40)="Order"
  1.  S $E(HEADER(5),71)="Test"
  1.  S HEADER(6)="LRODT"
  1.  S $E(HEADER(6),10)="LRODT"
  1.  S $E(HEADER(6),20)="LRSP"
  1.  S $E(HEADER(6),30)="ORDER #"
  1.  S $E(HEADER(6),40)="OERR #"
  1.  S $E(HEADER(6),52)="LROT"
  1.  S $E(HEADER(6),60)="Test IEN"
  1.  S $E(HEADER(6),71)="OERR #"
  1.  ;
  1.  S MAXLINES=IOS-4,LINES=MAXLINES+10
  1.  S (CNT,ORDERCNT,PG)=0
  1.  S QFLG="NO"
  1.  S LRODT=$$FMADD^XLFDT($P(LR1033ID,"."),-2)
  1.  Q "OK"
  1.  ;
  1. ORDLVLDA ; EP - Order Level Data
  1.  S ORDERCNT=ORDERCNT+1
  1.  S ORDERN=$$GET1^DIQ(69.01,LRSP_","_LRODT,9.5)
  1.  S ORDOERR=$$GET1^DIQ(69.01,LRSP_","_LRODT,.11)
  1.  Q
  1.  ;
  1. ROERRSTL ; EP - Line of Data
  1.  Q:$$ROERRSTB()="Q"
  1.  ;
  1.  I LINES>MAXLINES D HEADERPG^BLRGMENU(.PG,.QFLG,HDRONE)  Q:QFLG="Q"
  1.  ;
  1.  W LRODT,?9,$$FMTE^XLFDT(LRODT,"2DZ"),?19,LRSP,?29,ORDERN,?39,ORDOERR,?51,LROT,?60,F60IEN,?69,LROTOERR,!
  1.  S LINES=LINES+1
  1.  S CNT=CNT+1
  1.  Q
  1.  ;
  1. ROERRSTB() ; EP - "Break out" Data
  1.  S CANCELR=$$GET1^DIQ(69.3991,1_","_LROT_","_LRSP_","_LRODT,.01)
  1.  Q:CANCELR'["Clinical Indication" "Q"       ; Skip if no "Clinical Indication" string
  1.  ;
  1.  S LROTIEN=LROT_","_LRSP_","_LRODT
  1.  S LROTOERR=$$GET1^DIQ(69.03,LROTIEN,6)     ; OERR Number
  1.  Q:LROTOERR<1 "Q"                           ; Skip if no OERR Number
  1.  ;
  1.  S OERRSTS=$$GET1^DIQ(100,LROTOERR,5)       ; OERR Status
  1.  Q:OERRSTS'["PEND" "Q"                      ; Skip if OERR entry not PENDING
  1.  ;
  1.  S F60IEN=$$GET1^DIQ(69.03,LROTIEN,.01,"I")
  1.  Q:F60IEN<1 "Q"                             ; Skip if no File 60 IEN
  1.  ;
  1.  Q "OK"
  1.  ;
  1.  ; ============================= UTILITIES =============================
  1.  ;
  1. CHEKUSER() ; EP - Make sure User has the LRSUPER Key
  1.  Q:$D(^XUSEC("LRSUPER",DUZ)) "OK"
  1.  ;
  1.  S HEADER(1)="OERR Order Status Update"
  1.  S HEADER(2)="Lab Order OERR Status Utilities"
  1.  D HEADERDT^BLRGMENU
  1.  W !!,?9,"User ",$$GET1^DIQ(200,DUZ,.01)," [",DUZ,"] does *NOT* have the LRSUPER",!!
  1.  W ?4,"Security Key.  Routine Ends."
  1.  D PRESSKEY^BLRGMENU(9)
  1.  Q "Q"
  1.  ;
  1.  ;
  1. SETBLRVS(TWO) ; EP - Set BLRVERN variable(s)
  1.  S BLRVERN=$P($P($T(+1),";")," ")
  1.  S:$L($G(TWO)) BLRVERN2=TWO
  1.  Q