BLR7OGMP ; IHS/OIT/MKK - Lab Interim Report for EHR ; 13-Oct-2017 14:04 ; MKK
;;5.2;IHS LABORATORY;**1028,1030,1031,1033,1039,1041**;NOV 01, 1997;Build 23
;
; Cloned from LR7OGMP. This is a 127 column "report"
;
PRINT(OUTCNT) ; from LR7OGMC
NEW ACC,AGE,CDT,CMNT,DATA,DOC,FLAG,HIGH,IDT,INTP,LINE,LOW,LRCW,LRX,PORDER,PRNTCODE
NEW RANGE,REFHIGH,REFLOW,SEX,SITE,SPEC,SUB,TESTNUM
NEW TESTSPEC,THER,THERHIGH,THERLOW,UNITS,VALUE,X,ZERO
;
NEW LINESTR,LRPLS,TIDT,SITECNT,TLOCDNM
NEW SPECCOND ; IHS/MSC/MKK - LR*5.2*1033
;
; the variables AGE, SEX, LRCW, and X are used with the lab's print codes and ref ranges
S AGE=$P(^TMP("LR7OG",$J,"G"),U,4),SEX=$P(^("G"),U,5),LRCW=$P(^("G"),U,6)
S CDT=0
S SITECNT=0
F S CDT=$O(^TMP("LR7OG",$J,"TP",CDT)) Q:CDT="" D
. S IDT=9999999-CDT
. S ZERO=$S($D(^TMP("LR7OG",$J,"TP",CDT))#2:^(CDT),1:"")
. S SPEC=+$P(ZERO,U,5)
. S DOC=$$NAME(+$P(ZERO,U,10))
. ;
. D SETLINE("",.OUTCNT)
. ;
. S LINE=" Provider: "_DOC
. S ACC=$P(ZERO,U,6)
. S LINE=$$SETSTR^VALM1(" Accession: "_ACC,LINE,54,12+$L(ACC))
. D SETLINE(LINE,.OUTCNT)
. ;
. S LINE=" Specimen: "_$E($P($G(^LAB(61,SPEC,0),"<no specimen on file>"),U),1,25)_"."
. S $E(LINE,42)="Spec Collect Date/Time: "_$$UP^XLFSTR($$FMTE^XLFDT(CDT,"5MPZ")) ; IHS/OIT/MKK - LR*5.2*1030
. D SETLINE(LINE,.OUTCNT)
. ;
. D LABARRT ; Lab Arrival Time - IHS/MSC/MKK - LR*5.2*1039
. ;
. ; ----- BEGIN IHS/MSC/MKK - LR*5.2*1033
. S SPECCOND=$$CONDSPEC()
. I $L(SPECCOND) D
.. S LINE=" Specimen Condition: "_SPECCOND
.. D SETLINE(LINE,.OUTCNT)
. D SETLINE("",.OUTCNT)
. ;
. D RESULTHD ; 'Results' Header
. ; ----- END IHS/MSC/MKK - LR*5.2*1033
. ;
. S PORDER=0
. F S PORDER=$O(^TMP("LR7OG",$J,"TP",CDT,PORDER)) Q:PORDER'>0 S DATA=^(PORDER) D
.. I $P(DATA,U,7)="" Q
.. S TESTNUM=+DATA,PRNTCODE=$P(DATA,U,5),SUB=$P(DATA,U,6),FLAG=$P(DATA,U,8),X=$P(DATA,U,7),UNITS=$P(DATA,U,9),RANGE=$P(DATA,U,10),SITE=$P(DATA,U,11)
.. S STR=$G(^LAB(60,TESTNUM,1,SPEC,0))
.. S REFLOW=$P(STR,"^",2)
.. S REFHIGH=$P(STR,"^",3)
.. ;
.. S:$TR(REFLOW," ")'=""!($TR(REFHIGH," ")'="") RANGE=REFLOW_" - "_REFHIGH
.. S THERLOW=$P(STR,"^",11)
.. S THERHIGH=$P(STR,"^",12)
.. ;
.. I IDT S SITE=$P($G(^LR(LRDFN,"CH",IDT,+$P(SUB,";",2))),"^",9)
.. S:+$G(SITE) SITECNT=SITECNT+1
.. ;
.. D ZEROFIX(TESTNUM,.X) ; IHS/OIT/MKK - LR*5.2*1031
.. ;
.. I PRNTCODE="" S VALUE=X
.. I PRNTCODE'="" S @("VALUE="_PRNTCODE)
.. ;
.. I $G(RANGE)["$S(" D MUMPRNGE(.RANGE)
.. ;
.. ; ----- BEGIN IHS/MSC/MKK - LR*5.2*1031
.. ; S LOW=$$TRIM^XLFSTR($P($G(RANGE),"-"),"LR"," ")
.. ; S HIGH=$$TRIM^XLFSTR($P($G(RANGE),"-",2),"LR"," ")
.. ; D:$L(LOW) ZEROFIX(TESTNUM,.LOW)
.. ; D:$L(HIGH) ZEROFIX(TESTNUM,.HIGH)
.. ; I $L(LOW)!($L(HIGH)) S RANGE=$$EN^LRLRRVF(LOW,HIGH)
.. ; ----- END IHS/MSC/MKK - LR*5.2*1031
.. ;
.. ; ----- BEGIN IHS/MSC/MKK - LR*5.2*1033
.. I $L(RANGE)&($$UP^XLFSTR(RANGE)'[" TO ") D
... S LOW=$$TRIM^XLFSTR($P($G(RANGE),"-"),"LR"," ")
... S HIGH=$$TRIM^XLFSTR($P($G(RANGE),"-",2),"LR"," ")
... D:$L(LOW) ZEROFIX(TESTNUM,.LOW)
... D:$L(HIGH) ZEROFIX(TESTNUM,.HIGH)
... I $L(LOW)!($L(HIGH)) S RANGE=$$EN^LRLRRVF(LOW,HIGH)
.. ; I RANGE["Ref:" S RANGE=$P(RANGE,"Ref: ",2)
.. I RANGE["Ref:" S RANGE=$TR($P(RANGE,"Ref: ",2),"=") ; MU2 Only
.. ; ----- END IHS/MSC/MKK - LR*5.2*1033
.. ;
.. S LRX=$G(RANGE)
.. ;
.. ; Have to determine if Ref Ranges came from THERAPEUTIC fields
.. ; I $L(REFLOW)<1,$L(REFHIGH)<1,$L(THERLOW),$L(THERHIGH),$L(LRX) S LRX=LRX_"(TR)"
.. ;
.. I IDT S SITE=$P($G(^LR(LRDFN,"CH",IDT,+$P($G(SUB),";",2))),"^",9)
.. S:+$G(SITE) SITECNT=SITECNT+1
.. I SITE D
... ; S ^TMP("LRPLS",$J,SITE)=""
... S ^TMP("LRPLS",$J,SITE)=$P($G(^LR(LRDFN,"CH",IDT,"RF")),"^",2,3) ; IHS/MSC/MKK - LR*5.2*1033
.. ;
.. ; LINE will be 127 characters wide
.. K LINE
.. S LINE=$E($P(DATA,U,2),1,33) ; Test Description
.. S:$L(VALUE)<31 $E(LINE,35)=$G(VALUE) ; Result
.. S $E(LINE,67)=FLAG ; Abnormal Flag
.. ; S:+$G(UNITS) UNITS=$P($G(^BLRUCUM(UNITS,0)),"^")
.. S:UNITS?.N UNITS=$$GET1^DIQ(90475.3,UNITS,.01) ; IHS/MSC/MKK - LR*5.2*1041
.. S:$G(UNITS)'="" $E(LINE,70)=$E(UNITS,1,16) ; Units
.. ; S:$G(LRX)'="" $E(LINE,88)=$E(LRX,1,16) ; Reference Range
.. ; S:+$G(SITE) $E(LINE,106)="["_SITE_"]" ; Site
.. ; S:+$G(IDT) $E(LINE,113)=$TR($$FMTE^XLFDT($P($G(^LR(LRDFN,"CH",IDT,0)),"^",3),"2MZ"),"@"," ") ; Result Date/Time
.. ; ----- BEGIN IHS/MSC/MKK - LR*5.2*1033
.. I $L(LRX)<16 D
... S:$G(LRX)'="" $E(LINE,88)=$E(LRX,1,16) ; Reference Range
... S:+$G(SITE) $E(LINE,106)="["_SITE_"]" ; Site
... ; S:+$G(IDT) $E(LINE,113)=$TR($$FMTE^XLFDT($P($G(^LR(LRDFN,"CH",IDT,0)),"^",3),"2MZ"),"@"," ") ; Result Date/Time
... S:+$G(IDT) $E(LINE,113)=$$GETCOMPD()
.. I $L(LRX)>15 D REFWRAP
.. ; ----- END IHS/MSC/MKK - LR*5.2*1033
.. ;
.. D:$L($G(LINE)) SETLINE(LINE,.OUTCNT)
.. ;
.. D:$L(VALUE)>30 MULTIVAL(VALUE) ; Result was too long; make multi-line
.. ;
.. I $O(^TMP("LR7OG",$J,"TP",CDT,PORDER,0))>0 D
... S INTP=0
... F S INTP=+$O(^TMP("LR7OG",$J,"TP",CDT,PORDER,INTP)) Q:INTP<1 D SETLINE(" Eval: "_^(INTP),.OUTCNT)
. ;
. I $D(^TMP("LR7OG",$J,"TP",CDT,"C")) D
.. S LINE="Comment: "
.. S CMNT=0
.. F S CMNT=+$O(^TMP("LR7OG",$J,"TP",CDT,"C",CMNT)) Q:CMNT<1 S LINE=LINE_^(CMNT) D
... D SETLINE(LINE,.OUTCNT)
... I $O(^TMP("LR7OG",$J,"TP",CDT,"C",CMNT)) S LINE=" "
. ;
. D:SITECNT<1 SETLINE($TR($J("",132)," ","="),.OUTCNT)
. D:SITECNT>0 PLS
Q
;
RESULTHD ; EP - 'Results' Header
K LINESTR
S $E(LINESTR,66)="Res"
S $E(LINESTR,106)="Site"
D SETLINE(LINESTR,.OUTCNT)
K LINESTR
S LINESTR="Test name"
S $E(LINESTR,35)="Result"
S $E(LINESTR,66)="Flg"
S $E(LINESTR,70)="Units"
S $E(LINESTR,88)="Ref. range"
S $E(LINESTR,106)="Code"
S $E(LINESTR,113)="Result Dt/Time"
D SETLINE(LINESTR,.OUTCNT)
Q
;
MUMPRNGE(RANGE) ; EP -- MUMPS Code in Reference Range -- Evaluate and store
NEW LOW,HIGH,RV1,RV2
;
; S LOW=$$TRIM^XLFSTR($$TRIM^XLFSTR($P(RANGE,"-"),"R"," "),"L"," ")
; S HIGH=$$TRIM^XLFSTR($$TRIM^XLFSTR($P(RANGE,"-",2),"R"," "),"L"," ")
;
; ----- BEGIN IHS/OIT/MKK - LR*5.2*1030
; S LOW=$$TRIM^XLFSTR($$TRIM^XLFSTR($P(RANGE," - "),"R"," "),"L"," ")
; S:LOW[$C(34)_$C(34) LOW=$$DQUOTER(LOW)
;
; S HIGH=$$TRIM^XLFSTR($$TRIM^XLFSTR($P(RANGE," - ",2),"R"," "),"L"," ")
; S:HIGH[$C(34)_$C(34) HIGH=$$DQUOTER(HIGH)
; ----- END IHS/OIT/MKK - LR*5.2*1030
;
; ----- BEGIN IHS/OIT/MKK - LR*5.2*1033
S LOW=$$TRIM^XLFSTR($P(RANGE," - "),"LR"," ")
I LOW[$C(34)_$C(34),LOW'[$C(34)_$C(34)_$C(41),LOW'[$C(34)_$C(34)_$C(44) S LOW=$$DQUOTER(LOW)
;
S HIGH=$$TRIM^XLFSTR($P(RANGE," - ",2),"LR"," ")
I HIGH[$C(34)_$C(34),HIGH'[$C(34)_$C(34)_$C(41),HIGH'[$C(34)_$C(34)_$C(44) S HIGH=$$DQUOTER(HIGH)
; ----- END IHS/OIT/MKK - LR*5.2*1033
;
S RV1=$$MUMPEVAL(LOW)
S RV2=$$MUMPEVAL(HIGH)
;
S RANGE=RV1_" - "_RV2
S:$TR(RANGE," ")="-" RANGE="" ; IHS/MSC/MKK - LR*5.2*1033 - if no values, just return null string
;
Q
;
; ----- BEGIN IHS/OIT/MKK - LR*5.2*1030
DQUOTER(STR) ; EP -- Get rid of double quotes in string
NEW DBLQ,REMOVED
;
S DBLQ=$C(34)_$C(34) ; Double Quotes
S REMOVED=$$TRIM^XLFSTR(STR,"LR",$C(34)) ; Get rid of leading & traling quotes
F Q:REMOVED'[DBLQ D
. S REMOVED=$P(REMOVED,DBLQ,1)_$C(34)_$P(REMOVED,DBLQ,2,999)
;
Q REMOVED
; ----- END IHS/OIT/MKK - LR*5.2*1030
;
MUMPEVAL(EVAL) ;
NEW EVALLEN,STR,WOT
;
I EVAL'["$S(" Q EVAL
;
; ----- BEGIN IHS/MSC/MKK LR*5.2*1033
S EVALLEN=$L(EVAL)
I $E(EVAL,EVALLEN-3,EVALLEN)="1:"")" S $P(EVAL,":",$L(EVAL,":"))=$C(34)_$C(34)_")"
; ----- END IHS/MSC/MKK - LR*5.2*1033
;
S STR="WOT="_EVAL
S @STR
Q WOT
;
SETLINE(LINE,CNT) ;
S ^TMP("LR7OGX",$J,"OUTPUT",CNT)=LINE
S CNT=CNT+1
Q
;
;
NAME(X) ; $$(#) -> name
N LRDOC
D DOC^LRX
Q LRDOC
;
;
DD(Y) ; $$(date/time) -> date/time format
D DD^LRX
Q Y
;
;
PLS ; List performing laboratories
;
N LINE,LRPLS,X
N STR,COUNTY,COUNTRY,ICOUNTRY ; IHS/MSC/MKK - LR*5.2*1033
;
D SETLINE(" ",.OUTCNT)
D SETLINE("Performing Lab Site(s):",.OUTCNT)
S LRPLS=0
F S LRPLS=$O(^TMP("LRPLS",$J,LRPLS)) Q:LRPLS<1 D
. S LINE=$$LJ^XLFSTR("["_LRPLS_"] ",8)_$$NAME^XUAF4(LRPLS)
. S X=$$PADD^XUAF4(LRPLS) ; Physical Address
. S LINE=LINE_" "_$$REPEAT^XLFSTR(" ",8)_$P(X,U)_" "_$P(X,U,2)_", "_$P(X,U,3)_" "_$P(X,U,4)
. D SETLINE(LINE,.OUTCNT)
. ; ----- BEGIN IHS/MSC/MKK - LR*5.2*1033
. S STR=$G(^TMP("LRPLS",$J,LRPLS))
. Q:$L(STR)<1
. S COUNTY=$P(STR,"^"),COUNTRY=+$P(STR,"^",2)
. S LINE=$J("",8)_$$LJ^XLFSTR("County:"_COUNTY,15)
. S:COUNTRY LINE=LINE_"Country:"_$$GET1^DIQ(779.004,COUNTRY,"CODE")
. D SETLINE(LINE,.OUTCNT)
. ; ----- END IHS/MSC/MKK - LR*5.2*1033
;
D SETLINE($TR($J("",126)," ","="),.OUTCNT)
; D SETLINE("KEY: L=Abnormal Low H=Abnormal High *=Critical value TR=Therapeutic Range",.OUTCNT)
; ----- BEGIN IHS/OIT/MKK - LR*5.2*1030
S STR=$$CJ^XLFSTR("KEY: A=Abnormal L=Abnormal Low H=Abnormal High *=Critical value TR=Therapeutic Range",127)
D SETLINE(STR,.OUTCNT)
; ----- END IHS/OIT/MKK - LR*5.2*1030
;
K ^TMP("LRPLS",$J)
Q
;
; ----- BEGIN IHS/OIT/MKK - LR*5.2*1030
MULTIVAL(VALUE) ; EP - Multiple Line Value String
D USEDIWP(VALUE,34,91)
Q
;
USEDIWP(X,LM,CW) ; EP -- Use FileMan DIWP to wrap text
NEW CNT,LINE,STR
;
K ^UTILITY($J,"W")
S DIWL=LM,DIWR="",DIWF="C"_CW
D ^DIWP
S LINE=0
F S LINE=$O(^UTILITY($J,"W",LM,LINE)) Q:LINE<1 D
. S STR=$J("",LM)_$G(^UTILITY($J,"W",LM,LINE,0))
. D SETLINE(STR,.OUTCNT)
Q
; ----- END IHS/OIT/MKK - LR*5.2*1030
;
; ----- BEGIN IHS/MSC/MKK - LR*5.2*1031
ZEROFIX(F60PTR,RESULT) ; EP - Leading & Trailing Zero Fix for Results
NEW (DILOCKTM,DISYS,DT,DTIME,DUZ,F60PTR,IO,IOBS,IOF,IOM,ION,IOS,IOSL,IOST,IOT,IOXY,RESULT,U,XPARSYS,XQXFLG)
;
Q:$$UP^XLFSTR($G(RESULT))["SPECIMEN IN LAB" ; Skip if not resulted
;
Q:$L($G(RESULT))<1 ; Skip if no Result
Q:$L($G(F60PTR))<1 ; Skip if no File 60 Pointer
;
S DN=+$G(^LAB(60,F60PTR,.2))
Q:DN<1 ; Skip if no DataName
;
Q:$G(^DD(63.04,DN,0))'["^LRNUM" ; Skip if no numeric defintiion
;
S STR=$P($P($G(^DD(63.04,DN,0)),"Q9=",2),$C(34),2) ; Get numeric formatting
;
S DP=+$P(STR,",",3) ; Decimal Places
Q:DP<1 ; Skip if no Decimal Defintion
;
S SYMBOL="",ORIGRSLT=RESULT
F Q:$E(RESULT)="."!($E(RESULT)?1N)!(RESULT="") D ; Adjust if ANY Non-Numeric is at the beginning of RESULT
. S SYMBOL=SYMBOL_$E(RESULT)
. S RESULT=$E(RESULT,2,$L(RESULT))
;
S:$E(RESULT)="." RESULT="0"_RESULT ; Leading Zero Fix
;
I $E(RESULT)'?1N S RESULT=ORIGRSLT Q ; Skip if RESULT has no numeric part
;
S RESULT=$TR($FN(RESULT,"P",DP)," ")
;
S:$L($G(SYMBOL)) RESULT=SYMBOL_RESULT ; Restore "symbol", if necessary
;
Q
; ----- END IHS/MSC/MKK - LR*5.2*1031
;
; ----- BEGIN IHS/MSC/MKK - LR*5.2*1033
REFWRAP ; EP -- Reference Range String too long -- have to wrap it
NEW LINER,LM,MAX
;
S MAX=15
;
; Use FileMan DIWP routine to "wrap" string
S X=LRX
K ^UTILITY($J,"W")
S LM=2
S DIWL=LM,DIWR="",DIWF="C"_MAX
D ^DIWP
;
M ^XTMP("BLR7OGMP",$J)=^UTILITY($J)
;
S $E(LINE,88)=$G(^UTILITY($J,"W",2,1,0)) ; Reference Range
S:+$G(SITE) $E(LINE,106)="["_SITE_"]" ; Site
; S:+$G(IDT) $E(LINE,113)=$TR($$FMTE^XLFDT($P($G(^LR(LRDFN,"CH",IDT,0)),"^",3),"2MZ"),"@"," ") ; Result Date/Time
S:+$G(IDT) $E(LINE,113)=$$GETCOMPD()
D SETLINE(LINE,.OUTCNT)
;
S LINER=1
F S LINER=$O(^UTILITY($J,"W",2,LINER)) Q:LINER<1 D
. K LINE
. S $E(LINE,88)=$G(^UTILITY($J,"W",2,LINER,0))
. D SETLINE(LINE,.OUTCNT)
K ^UTILITY($J,"W"),LINE
Q
;
CONDSPEC() ; EP - Specimen Condition
Q $P($G(^LR(+LRDFN,"CH",+IDT,"IHS")),"^")
;
GETCOMPD() ; EP - Get Completion Date
NEW DATEHERE,DATANAME,LRSS
;
S LRSS=$P($P(DATA,"^",6),";")
Q:LRSS="" " "
;
S DATANAME=+$P($P(DATA,"^",6),";",2)
;
I LRSS="CH" D
. S DATEHERE=+$G(^LR(LRDFN,"CH",IDT,DATANAME,"IHS"))
;
I LRSS="MI" D
. S DATEHERE=+$P($G(^LR(LRDFN,"MI",IDT,"IHS")),"^",3)
;
S:$L(DATEHERE)<7 DATEHERE=+$P($G(^LR(LRDFN,LRSS,IDT,0)),"^",3)
;
S DATEHERE=$S(DATEHERE:$TR($$FMTE^XLFDT(DATEHERE,"2MZ"),"@"," "),1:" ")
;
Q DATEHERE
;
; ----- END IHS/MSC/MKK - LR*5.2*1033
;
; ----- BEGIN IHS/MSC/MKK - LR*5.2*1039
LABARRT ; EP - Lab Arrival Time
NEW LABARRT,LRAS,LRAA,LRAD,LRAN
S LRAS=$P(ZERO,U,6)
Q:$$GETACCCP^BLRUTIL3(LRAS,.LRAA,.LRAD,.LRAN)<1
;
S LABARRT=$$GET1^DIQ(68.02,LRAN_","_LRAD_","_LRAA,12,"I")
Q:+LABARRT<1
;
K LINE
S $E(LINE,43)="Lab Arrival Date/Time: "_$$UP^XLFSTR($$FMTE^XLFDT(LABARRT,"5MPZ"))
D SETLINE(LINE,.OUTCNT)
K LINE
Q
; ----- END IHS/MSC/MKK - LR*5.2*1039
BLR7OGMP ; IHS/OIT/MKK - Lab Interim Report for EHR ; 13-Oct-2017 14:04 ; MKK
+1 ;;5.2;IHS LABORATORY;**1028,1030,1031,1033,1039,1041**;NOV 01, 1997;Build 23
+2 ;
+3 ; Cloned from LR7OGMP. This is a 127 column "report"
+4 ;
PRINT(OUTCNT) ; from LR7OGMC
+1 NEW ACC,AGE,CDT,CMNT,DATA,DOC,FLAG,HIGH,IDT,INTP,LINE,LOW,LRCW,LRX,PORDER,PRNTCODE
+2 NEW RANGE,REFHIGH,REFLOW,SEX,SITE,SPEC,SUB,TESTNUM
+3 NEW TESTSPEC,THER,THERHIGH,THERLOW,UNITS,VALUE,X,ZERO
+4 ;
+5 NEW LINESTR,LRPLS,TIDT,SITECNT,TLOCDNM
+6 ; IHS/MSC/MKK - LR*5.2*1033
NEW SPECCOND
+7 ;
+8 ; the variables AGE, SEX, LRCW, and X are used with the lab's print codes and ref ranges
+9 SET AGE=$PIECE(^TMP("LR7OG",$JOB,"G"),U,4)
SET SEX=$PIECE(^("G"),U,5)
SET LRCW=$PIECE(^("G"),U,6)
+10 SET CDT=0
+11 SET SITECNT=0
+12 FOR
SET CDT=$ORDER(^TMP("LR7OG",$JOB,"TP",CDT))
IF CDT=""
QUIT
Begin DoDot:1
+13 SET IDT=9999999-CDT
+14 SET ZERO=$SELECT($DATA(^TMP("LR7OG",$JOB,"TP",CDT))#2:^(CDT),1:"")
+15 SET SPEC=+$PIECE(ZERO,U,5)
+16 SET DOC=$$NAME(+$PIECE(ZERO,U,10))
+17 ;
+18 DO SETLINE("",.OUTCNT)
+19 ;
+20 SET LINE=" Provider: "_DOC
+21 SET ACC=$PIECE(ZERO,U,6)
+22 SET LINE=$$SETSTR^VALM1(" Accession: "_ACC,LINE,54,12+$LENGTH(ACC))
+23 DO SETLINE(LINE,.OUTCNT)
+24 ;
+25 SET LINE=" Specimen: "_$EXTRACT($PIECE($GET(^LAB(61,SPEC,0),"<no specimen on file>"),U),1,25)_"."
+26 ; IHS/OIT/MKK - LR*5.2*1030
SET $EXTRACT(LINE,42)="Spec Collect Date/Time: "_$$UP^XLFSTR($$FMTE^XLFDT(CDT,"5MPZ"))
+27 DO SETLINE(LINE,.OUTCNT)
+28 ;
+29 ; Lab Arrival Time - IHS/MSC/MKK - LR*5.2*1039
DO LABARRT
+30 ;
+31 ; ----- BEGIN IHS/MSC/MKK - LR*5.2*1033
+32 SET SPECCOND=$$CONDSPEC()
+33 IF $LENGTH(SPECCOND)
Begin DoDot:2
+34 SET LINE=" Specimen Condition: "_SPECCOND
+35 DO SETLINE(LINE,.OUTCNT)
End DoDot:2
+36 DO SETLINE("",.OUTCNT)
+37 ;
+38 ; 'Results' Header
DO RESULTHD
+39 ; ----- END IHS/MSC/MKK - LR*5.2*1033
+40 ;
+41 SET PORDER=0
+42 FOR
SET PORDER=$ORDER(^TMP("LR7OG",$JOB,"TP",CDT,PORDER))
IF PORDER'>0
QUIT
SET DATA=^(PORDER)
Begin DoDot:2
+43 IF $PIECE(DATA,U,7)=""
QUIT
+44 SET TESTNUM=+DATA
SET PRNTCODE=$PIECE(DATA,U,5)
SET SUB=$PIECE(DATA,U,6)
SET FLAG=$PIECE(DATA,U,8)
SET X=$PIECE(DATA,U,7)
SET UNITS=$PIECE(DATA,U,9)
SET RANGE=$PIECE(DATA,U,10)
SET SITE=$PIECE(DATA,U,11)
+45 SET STR=$GET(^LAB(60,TESTNUM,1,SPEC,0))
+46 SET REFLOW=$PIECE(STR,"^",2)
+47 SET REFHIGH=$PIECE(STR,"^",3)
+48 ;
+49 IF $TRANSLATE(REFLOW," ")'=""!($TRANSLATE(REFHIGH," ")'="")
SET RANGE=REFLOW_" - "_REFHIGH
+50 SET THERLOW=$PIECE(STR,"^",11)
+51 SET THERHIGH=$PIECE(STR,"^",12)
+52 ;
+53 IF IDT
SET SITE=$PIECE($GET(^LR(LRDFN,"CH",IDT,+$PIECE(SUB,";",2))),"^",9)
+54 IF +$GET(SITE)
SET SITECNT=SITECNT+1
+55 ;
+56 ; IHS/OIT/MKK - LR*5.2*1031
DO ZEROFIX(TESTNUM,.X)
+57 ;
+58 IF PRNTCODE=""
SET VALUE=X
+59 IF PRNTCODE'=""
SET @("VALUE="_PRNTCODE)
+60 ;
+61 IF $GET(RANGE)["$S("
DO MUMPRNGE(.RANGE)
+62 ;
+63 ; ----- BEGIN IHS/MSC/MKK - LR*5.2*1031
+64 ; S LOW=$$TRIM^XLFSTR($P($G(RANGE),"-"),"LR"," ")
+65 ; S HIGH=$$TRIM^XLFSTR($P($G(RANGE),"-",2),"LR"," ")
+66 ; D:$L(LOW) ZEROFIX(TESTNUM,.LOW)
+67 ; D:$L(HIGH) ZEROFIX(TESTNUM,.HIGH)
+68 ; I $L(LOW)!($L(HIGH)) S RANGE=$$EN^LRLRRVF(LOW,HIGH)
+69 ; ----- END IHS/MSC/MKK - LR*5.2*1031
+70 ;
+71 ; ----- BEGIN IHS/MSC/MKK - LR*5.2*1033
+72 IF $LENGTH(RANGE)&($$UP^XLFSTR(RANGE)'[" TO ")
Begin DoDot:3
+73 SET LOW=$$TRIM^XLFSTR($PIECE($GET(RANGE),"-"),"LR"," ")
+74 SET HIGH=$$TRIM^XLFSTR($PIECE($GET(RANGE),"-",2),"LR"," ")
+75 IF $LENGTH(LOW)
DO ZEROFIX(TESTNUM,.LOW)
+76 IF $LENGTH(HIGH)
DO ZEROFIX(TESTNUM,.HIGH)
+77 IF $LENGTH(LOW)!($LENGTH(HIGH))
SET RANGE=$$EN^LRLRRVF(LOW,HIGH)
End DoDot:3
+78 ; I RANGE["Ref:" S RANGE=$P(RANGE,"Ref: ",2)
+79 ; MU2 Only
IF RANGE["Ref:"
SET RANGE=$TRANSLATE($PIECE(RANGE,"Ref: ",2),"=")
+80 ; ----- END IHS/MSC/MKK - LR*5.2*1033
+81 ;
+82 SET LRX=$GET(RANGE)
+83 ;
+84 ; Have to determine if Ref Ranges came from THERAPEUTIC fields
+85 ; I $L(REFLOW)<1,$L(REFHIGH)<1,$L(THERLOW),$L(THERHIGH),$L(LRX) S LRX=LRX_"(TR)"
+86 ;
+87 IF IDT
SET SITE=$PIECE($GET(^LR(LRDFN,"CH",IDT,+$PIECE($GET(SUB),";",2))),"^",9)
+88 IF +$GET(SITE)
SET SITECNT=SITECNT+1
+89 IF SITE
Begin DoDot:3
+90 ; S ^TMP("LRPLS",$J,SITE)=""
+91 ; IHS/MSC/MKK - LR*5.2*1033
SET ^TMP("LRPLS",$JOB,SITE)=$PIECE($GET(^LR(LRDFN,"CH",IDT,"RF")),"^",2,3)
End DoDot:3
+92 ;
+93 ; LINE will be 127 characters wide
+94 KILL LINE
+95 ; Test Description
SET LINE=$EXTRACT($PIECE(DATA,U,2),1,33)
+96 ; Result
IF $LENGTH(VALUE)<31
SET $EXTRACT(LINE,35)=$GET(VALUE)
+97 ; Abnormal Flag
SET $EXTRACT(LINE,67)=FLAG
+98 ; S:+$G(UNITS) UNITS=$P($G(^BLRUCUM(UNITS,0)),"^")
+99 ; IHS/MSC/MKK - LR*5.2*1041
IF UNITS?.N
SET UNITS=$$GET1^DIQ(90475.3,UNITS,.01)
+100 ; Units
IF $GET(UNITS)'=""
SET $EXTRACT(LINE,70)=$EXTRACT(UNITS,1,16)
+101 ; S:$G(LRX)'="" $E(LINE,88)=$E(LRX,1,16) ; Reference Range
+102 ; S:+$G(SITE) $E(LINE,106)="["_SITE_"]" ; Site
+103 ; S:+$G(IDT) $E(LINE,113)=$TR($$FMTE^XLFDT($P($G(^LR(LRDFN,"CH",IDT,0)),"^",3),"2MZ"),"@"," ") ; Result Date/Time
+104 ; ----- BEGIN IHS/MSC/MKK - LR*5.2*1033
+105 IF $LENGTH(LRX)<16
Begin DoDot:3
+106 ; Reference Range
IF $GET(LRX)'=""
SET $EXTRACT(LINE,88)=$EXTRACT(LRX,1,16)
+107 ; Site
IF +$GET(SITE)
SET $EXTRACT(LINE,106)="["_SITE_"]"
+108 ; S:+$G(IDT) $E(LINE,113)=$TR($$FMTE^XLFDT($P($G(^LR(LRDFN,"CH",IDT,0)),"^",3),"2MZ"),"@"," ") ; Result Date/Time
+109 IF +$GET(IDT)
SET $EXTRACT(LINE,113)=$$GETCOMPD()
End DoDot:3
+110 IF $LENGTH(LRX)>15
DO REFWRAP
+111 ; ----- END IHS/MSC/MKK - LR*5.2*1033
+112 ;
+113 IF $LENGTH($GET(LINE))
DO SETLINE(LINE,.OUTCNT)
+114 ;
+115 ; Result was too long; make multi-line
IF $LENGTH(VALUE)>30
DO MULTIVAL(VALUE)
+116 ;
+117 IF $ORDER(^TMP("LR7OG",$JOB,"TP",CDT,PORDER,0))>0
Begin DoDot:3
+118 SET INTP=0
+119 FOR
SET INTP=+$ORDER(^TMP("LR7OG",$JOB,"TP",CDT,PORDER,INTP))
IF INTP<1
QUIT
DO SETLINE(" Eval: "_^(INTP),.OUTCNT)
End DoDot:3
End DoDot:2
+120 ;
+121 IF $DATA(^TMP("LR7OG",$JOB,"TP",CDT,"C"))
Begin DoDot:2
+122 SET LINE="Comment: "
+123 SET CMNT=0
+124 FOR
SET CMNT=+$ORDER(^TMP("LR7OG",$JOB,"TP",CDT,"C",CMNT))
IF CMNT<1
QUIT
SET LINE=LINE_^(CMNT)
Begin DoDot:3
+125 DO SETLINE(LINE,.OUTCNT)
+126 IF $ORDER(^TMP("LR7OG",$JOB,"TP",CDT,"C",CMNT))
SET LINE=" "
End DoDot:3
End DoDot:2
+127 ;
+128 IF SITECNT<1
DO SETLINE($TRANSLATE($JUSTIFY("",132)," ","="),.OUTCNT)
+129 IF SITECNT>0
DO PLS
End DoDot:1
+130 QUIT
+131 ;
RESULTHD ; EP - 'Results' Header
+1 KILL LINESTR
+2 SET $EXTRACT(LINESTR,66)="Res"
+3 SET $EXTRACT(LINESTR,106)="Site"
+4 DO SETLINE(LINESTR,.OUTCNT)
+5 KILL LINESTR
+6 SET LINESTR="Test name"
+7 SET $EXTRACT(LINESTR,35)="Result"
+8 SET $EXTRACT(LINESTR,66)="Flg"
+9 SET $EXTRACT(LINESTR,70)="Units"
+10 SET $EXTRACT(LINESTR,88)="Ref. range"
+11 SET $EXTRACT(LINESTR,106)="Code"
+12 SET $EXTRACT(LINESTR,113)="Result Dt/Time"
+13 DO SETLINE(LINESTR,.OUTCNT)
+14 QUIT
+15 ;
MUMPRNGE(RANGE) ; EP -- MUMPS Code in Reference Range -- Evaluate and store
+1 NEW LOW,HIGH,RV1,RV2
+2 ;
+3 ; S LOW=$$TRIM^XLFSTR($$TRIM^XLFSTR($P(RANGE,"-"),"R"," "),"L"," ")
+4 ; S HIGH=$$TRIM^XLFSTR($$TRIM^XLFSTR($P(RANGE,"-",2),"R"," "),"L"," ")
+5 ;
+6 ; ----- BEGIN IHS/OIT/MKK - LR*5.2*1030
+7 ; S LOW=$$TRIM^XLFSTR($$TRIM^XLFSTR($P(RANGE," - "),"R"," "),"L"," ")
+8 ; S:LOW[$C(34)_$C(34) LOW=$$DQUOTER(LOW)
+9 ;
+10 ; S HIGH=$$TRIM^XLFSTR($$TRIM^XLFSTR($P(RANGE," - ",2),"R"," "),"L"," ")
+11 ; S:HIGH[$C(34)_$C(34) HIGH=$$DQUOTER(HIGH)
+12 ; ----- END IHS/OIT/MKK - LR*5.2*1030
+13 ;
+14 ; ----- BEGIN IHS/OIT/MKK - LR*5.2*1033
+15 SET LOW=$$TRIM^XLFSTR($PIECE(RANGE," - "),"LR"," ")
+16 IF LOW[$CHAR(34)_$CHAR(34)
IF LOW'[$CHAR(34)_$CHAR(34)_$CHAR(41)
IF LOW'[$CHAR(34)_$CHAR(34)_$CHAR(44)
SET LOW=$$DQUOTER(LOW)
+17 ;
+18 SET HIGH=$$TRIM^XLFSTR($PIECE(RANGE," - ",2),"LR"," ")
+19 IF HIGH[$CHAR(34)_$CHAR(34)
IF HIGH'[$CHAR(34)_$CHAR(34)_$CHAR(41)
IF HIGH'[$CHAR(34)_$CHAR(34)_$CHAR(44)
SET HIGH=$$DQUOTER(HIGH)
+20 ; ----- END IHS/OIT/MKK - LR*5.2*1033
+21 ;
+22 SET RV1=$$MUMPEVAL(LOW)
+23 SET RV2=$$MUMPEVAL(HIGH)
+24 ;
+25 SET RANGE=RV1_" - "_RV2
+26 ; IHS/MSC/MKK - LR*5.2*1033 - if no values, just return null string
IF $TRANSLATE(RANGE," ")="-"
SET RANGE=""
+27 ;
+28 QUIT
+29 ;
+30 ; ----- BEGIN IHS/OIT/MKK - LR*5.2*1030
DQUOTER(STR) ; EP -- Get rid of double quotes in string
+1 NEW DBLQ,REMOVED
+2 ;
+3 ; Double Quotes
SET DBLQ=$CHAR(34)_$CHAR(34)
+4 ; Get rid of leading & traling quotes
SET REMOVED=$$TRIM^XLFSTR(STR,"LR",$CHAR(34))
+5 FOR
IF REMOVED'[DBLQ
QUIT
Begin DoDot:1
+6 SET REMOVED=$PIECE(REMOVED,DBLQ,1)_$CHAR(34)_$PIECE(REMOVED,DBLQ,2,999)
End DoDot:1
+7 ;
+8 QUIT REMOVED
+9 ; ----- END IHS/OIT/MKK - LR*5.2*1030
+10 ;
MUMPEVAL(EVAL) ;
+1 NEW EVALLEN,STR,WOT
+2 ;
+3 IF EVAL'["$S("
QUIT EVAL
+4 ;
+5 ; ----- BEGIN IHS/MSC/MKK LR*5.2*1033
+6 SET EVALLEN=$LENGTH(EVAL)
+7 IF $EXTRACT(EVAL,EVALLEN-3,EVALLEN)="1:"")"
SET $PIECE(EVAL,":",$LENGTH(EVAL,":"))=$CHAR(34)_$CHAR(34)_")"
+8 ; ----- END IHS/MSC/MKK - LR*5.2*1033
+9 ;
+10 SET STR="WOT="_EVAL
+11 SET @STR
+12 QUIT WOT
+13 ;
SETLINE(LINE,CNT) ;
+1 SET ^TMP("LR7OGX",$JOB,"OUTPUT",CNT)=LINE
+2 SET CNT=CNT+1
+3 QUIT
+4 ;
+5 ;
NAME(X) ; $$(#) -> name
+1 NEW LRDOC
+2 DO DOC^LRX
+3 QUIT LRDOC
+4 ;
+5 ;
DD(Y) ; $$(date/time) -> date/time format
+1 DO DD^LRX
+2 QUIT Y
+3 ;
+4 ;
PLS ; List performing laboratories
+1 ;
+2 NEW LINE,LRPLS,X
+3 ; IHS/MSC/MKK - LR*5.2*1033
NEW STR,COUNTY,COUNTRY,ICOUNTRY
+4 ;
+5 DO SETLINE(" ",.OUTCNT)
+6 DO SETLINE("Performing Lab Site(s):",.OUTCNT)
+7 SET LRPLS=0
+8 FOR
SET LRPLS=$ORDER(^TMP("LRPLS",$JOB,LRPLS))
IF LRPLS<1
QUIT
Begin DoDot:1
+9 SET LINE=$$LJ^XLFSTR("["_LRPLS_"] ",8)_$$NAME^XUAF4(LRPLS)
+10 ; Physical Address
SET X=$$PADD^XUAF4(LRPLS)
+11 SET LINE=LINE_" "_$$REPEAT^XLFSTR(" ",8)_$PIECE(X,U)_" "_$PIECE(X,U,2)_", "_$PIECE(X,U,3)_" "_$PIECE(X,U,4)
+12 DO SETLINE(LINE,.OUTCNT)
+13 ; ----- BEGIN IHS/MSC/MKK - LR*5.2*1033
+14 SET STR=$GET(^TMP("LRPLS",$JOB,LRPLS))
+15 IF $LENGTH(STR)<1
QUIT
+16 SET COUNTY=$PIECE(STR,"^")
SET COUNTRY=+$PIECE(STR,"^",2)
+17 SET LINE=$JUSTIFY("",8)_$$LJ^XLFSTR("County:"_COUNTY,15)
+18 IF COUNTRY
SET LINE=LINE_"Country:"_$$GET1^DIQ(779.004,COUNTRY,"CODE")
+19 DO SETLINE(LINE,.OUTCNT)
+20 ; ----- END IHS/MSC/MKK - LR*5.2*1033
End DoDot:1
+21 ;
+22 DO SETLINE($TRANSLATE($JUSTIFY("",126)," ","="),.OUTCNT)
+23 ; D SETLINE("KEY: L=Abnormal Low H=Abnormal High *=Critical value TR=Therapeutic Range",.OUTCNT)
+24 ; ----- BEGIN IHS/OIT/MKK - LR*5.2*1030
+25 SET STR=$$CJ^XLFSTR("KEY: A=Abnormal L=Abnormal Low H=Abnormal High *=Critical value TR=Therapeutic Range",127)
+26 DO SETLINE(STR,.OUTCNT)
+27 ; ----- END IHS/OIT/MKK - LR*5.2*1030
+28 ;
+29 KILL ^TMP("LRPLS",$JOB)
+30 QUIT
+31 ;
+32 ; ----- BEGIN IHS/OIT/MKK - LR*5.2*1030
MULTIVAL(VALUE) ; EP - Multiple Line Value String
+1 DO USEDIWP(VALUE,34,91)
+2 QUIT
+3 ;
USEDIWP(X,LM,CW) ; EP -- Use FileMan DIWP to wrap text
+1 NEW CNT,LINE,STR
+2 ;
+3 KILL ^UTILITY($JOB,"W")
+4 SET DIWL=LM
SET DIWR=""
SET DIWF="C"_CW
+5 DO ^DIWP
+6 SET LINE=0
+7 FOR
SET LINE=$ORDER(^UTILITY($JOB,"W",LM,LINE))
IF LINE<1
QUIT
Begin DoDot:1
+8 SET STR=$JUSTIFY("",LM)_$GET(^UTILITY($JOB,"W",LM,LINE,0))
+9 DO SETLINE(STR,.OUTCNT)
End DoDot:1
+10 QUIT
+11 ; ----- END IHS/OIT/MKK - LR*5.2*1030
+12 ;
+13 ; ----- BEGIN IHS/MSC/MKK - LR*5.2*1031
ZEROFIX(F60PTR,RESULT) ; EP - Leading & Trailing Zero Fix for Results
+1 NEW (DILOCKTM,DISYS,DT,DTIME,DUZ,F60PTR,IO,IOBS,IOF,IOM,ION,IOS,IOSL,IOST,IOT,IOXY,RESULT,U,XPARSYS,XQXFLG)
+2 ;
+3 ; Skip if not resulted
IF $$UP^XLFSTR($GET(RESULT))["SPECIMEN IN LAB"
QUIT
+4 ;
+5 ; Skip if no Result
IF $LENGTH($GET(RESULT))<1
QUIT
+6 ; Skip if no File 60 Pointer
IF $LENGTH($GET(F60PTR))<1
QUIT
+7 ;
+8 SET DN=+$GET(^LAB(60,F60PTR,.2))
+9 ; Skip if no DataName
IF DN<1
QUIT
+10 ;
+11 ; Skip if no numeric defintiion
IF $GET(^DD(63.04,DN,0))'["^LRNUM"
QUIT
+12 ;
+13 ; Get numeric formatting
SET STR=$PIECE($PIECE($GET(^DD(63.04,DN,0)),"Q9=",2),$CHAR(34),2)
+14 ;
+15 ; Decimal Places
SET DP=+$PIECE(STR,",",3)
+16 ; Skip if no Decimal Defintion
IF DP<1
QUIT
+17 ;
+18 SET SYMBOL=""
SET ORIGRSLT=RESULT
+19 ; Adjust if ANY Non-Numeric is at the beginning of RESULT
FOR
IF $EXTRACT(RESULT)="."!($EXTRACT(RESULT)?1N)!(RESULT="")
QUIT
Begin DoDot:1
+20 SET SYMBOL=SYMBOL_$EXTRACT(RESULT)
+21 SET RESULT=$EXTRACT(RESULT,2,$LENGTH(RESULT))
End DoDot:1
+22 ;
+23 ; Leading Zero Fix
IF $EXTRACT(RESULT)="."
SET RESULT="0"_RESULT
+24 ;
+25 ; Skip if RESULT has no numeric part
IF $EXTRACT(RESULT)'?1N
SET RESULT=ORIGRSLT
QUIT
+26 ;
+27 SET RESULT=$TRANSLATE($FNUMBER(RESULT,"P",DP)," ")
+28 ;
+29 ; Restore "symbol", if necessary
IF $LENGTH($GET(SYMBOL))
SET RESULT=SYMBOL_RESULT
+30 ;
+31 QUIT
+32 ; ----- END IHS/MSC/MKK - LR*5.2*1031
+33 ;
+34 ; ----- BEGIN IHS/MSC/MKK - LR*5.2*1033
REFWRAP ; EP -- Reference Range String too long -- have to wrap it
+1 NEW LINER,LM,MAX
+2 ;
+3 SET MAX=15
+4 ;
+5 ; Use FileMan DIWP routine to "wrap" string
+6 SET X=LRX
+7 KILL ^UTILITY($JOB,"W")
+8 SET LM=2
+9 SET DIWL=LM
SET DIWR=""
SET DIWF="C"_MAX
+10 DO ^DIWP
+11 ;
+12 MERGE ^XTMP("BLR7OGMP",$JOB)=^UTILITY($JOB)
+13 ;
+14 ; Reference Range
SET $EXTRACT(LINE,88)=$GET(^UTILITY($JOB,"W",2,1,0))
+15 ; Site
IF +$GET(SITE)
SET $EXTRACT(LINE,106)="["_SITE_"]"
+16 ; S:+$G(IDT) $E(LINE,113)=$TR($$FMTE^XLFDT($P($G(^LR(LRDFN,"CH",IDT,0)),"^",3),"2MZ"),"@"," ") ; Result Date/Time
+17 IF +$GET(IDT)
SET $EXTRACT(LINE,113)=$$GETCOMPD()
+18 DO SETLINE(LINE,.OUTCNT)
+19 ;
+20 SET LINER=1
+21 FOR
SET LINER=$ORDER(^UTILITY($JOB,"W",2,LINER))
IF LINER<1
QUIT
Begin DoDot:1
+22 KILL LINE
+23 SET $EXTRACT(LINE,88)=$GET(^UTILITY($JOB,"W",2,LINER,0))
+24 DO SETLINE(LINE,.OUTCNT)
End DoDot:1
+25 KILL ^UTILITY($JOB,"W"),LINE
+26 QUIT
+27 ;
CONDSPEC() ; EP - Specimen Condition
+1 QUIT $PIECE($GET(^LR(+LRDFN,"CH",+IDT,"IHS")),"^")
+2 ;
GETCOMPD() ; EP - Get Completion Date
+1 NEW DATEHERE,DATANAME,LRSS
+2 ;
+3 SET LRSS=$PIECE($PIECE(DATA,"^",6),";")
+4 IF LRSS=""
QUIT " "
+5 ;
+6 SET DATANAME=+$PIECE($PIECE(DATA,"^",6),";",2)
+7 ;
+8 IF LRSS="CH"
Begin DoDot:1
+9 SET DATEHERE=+$GET(^LR(LRDFN,"CH",IDT,DATANAME,"IHS"))
End DoDot:1
+10 ;
+11 IF LRSS="MI"
Begin DoDot:1
+12 SET DATEHERE=+$PIECE($GET(^LR(LRDFN,"MI",IDT,"IHS")),"^",3)
End DoDot:1
+13 ;
+14 IF $LENGTH(DATEHERE)<7
SET DATEHERE=+$PIECE($GET(^LR(LRDFN,LRSS,IDT,0)),"^",3)
+15 ;
+16 SET DATEHERE=$SELECT(DATEHERE:$TRANSLATE($$FMTE^XLFDT(DATEHERE,"2MZ"),"@"," "),1:" ")
+17 ;
+18 QUIT DATEHERE
+19 ;
+20 ; ----- END IHS/MSC/MKK - LR*5.2*1033
+21 ;
+22 ; ----- BEGIN IHS/MSC/MKK - LR*5.2*1039
LABARRT ; EP - Lab Arrival Time
+1 NEW LABARRT,LRAS,LRAA,LRAD,LRAN
+2 SET LRAS=$PIECE(ZERO,U,6)
+3 IF $$GETACCCP^BLRUTIL3(LRAS,.LRAA,.LRAD,.LRAN)<1
QUIT
+4 ;
+5 SET LABARRT=$$GET1^DIQ(68.02,LRAN_","_LRAD_","_LRAA,12,"I")
+6 IF +LABARRT<1
QUIT
+7 ;
+8 KILL LINE
+9 SET $EXTRACT(LINE,43)="Lab Arrival Date/Time: "_$$UP^XLFSTR($$FMTE^XLFDT(LABARRT,"5MPZ"))
+10 DO SETLINE(LINE,.OUTCNT)
+11 KILL LINE
+12 QUIT
+13 ; ----- END IHS/MSC/MKK - LR*5.2*1039
