BLR7OGMP.m

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)