LR7OGMG ;VA/DALOI/STAFF- Interim report rpc memo grid ; 03-Jul-2014 07:41 ; MKK
;;5.2;LAB SERVICE;**187,230,1018,286,1027,331,364,395,1031,1033,1039**;NOV 1, 1997;Build 146
;
GRID(OUTCNT) ; from LR7OGMC
N ACC,AGE,CDT,CMNT,CNT,DATA,DOC,FLAG,IDT,INTP,LINE,LRCW,LRX,MPLS,PLS,PORDER,PRNTCODE,RANGE,SEX,SPEC,SUB,TCNT,TESTNAME,TESTNUM
N UNITS,VALUE,X,ZERO,INEXACT,DISPDATE
; the variables AGE, SEX, LRCW, and X are used withing the lab's print codes and ref ranges
K ^TMP("LRMPLS",$J)
S AGE=$P(^TMP("LR7OG",$J,"G"),U,4),SEX=$P(^("G"),U,5),LRCW=$P(^("G"),U,6)
S CDT=+$O(^TMP("LR7OG",$J,"TP",0)) Q:'CDT
S IDT=9999999-CDT
S ZERO=$S($D(^TMP("LR7OG",$J,"TP",CDT))#2:^(CDT),1:"")
S SPEC=+$P(ZERO,U,5)
S INEXACT=$P(ZERO,U,2),DISPDATE=$S(INEXACT:CDT\1,1:CDT)
S DOC=$$NAME^LR7OGMP(+$P(ZERO,U,10))
S ACC=$P(ZERO,U,6)
S $P(^TMP("LR7OGX",$J,"OUTPUT",1),U,4,6)=SPEC_U_$P($G(^LAB(61,SPEC,0)),U)_U_ACC_U_DOC
S $P(^TMP("LR7OGX",$J,"OUTPUT",1),U,10)=DISPDATE
S (TCNT,MPLS,PORDER,PLS)=0
S PLS=$O(^TMP("LRPLS",$J,0))
I $O(^TMP("LRPLS",$J,PLS)) S MPLS=1 ; multiple performing labs
F S PORDER=$O(^TMP("LR7OG",$J,"TP",CDT,PORDER)) Q:PORDER'>0 S DATA=^(PORDER) D
. I $P(DATA,U,7)="" Q
. S TCNT=TCNT+1
. S TESTNUM=+DATA,TESTNAME=$P(DATA,U,2),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),PLS=$P(DATA,U,11)
. ;
. ; ----- BEGIN IHS/MSC/MKK - LR*5.2*1031
. ; NEW LOW,HIGH
. ; 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)
. ; S ^BLR7OGMG("LR7OGMG",$J,"DID IT")=LOW_"^"_HIGH_"^"_RANGE
. ; K LOW,HIGH
. ; ----- END IHS/MSC/MKK - LR*5.2*1031
. ;
. ; ----- BEGIN IHS/MSC/MKK - LR*5.2*1033
. I $$UP^XLFSTR(RANGE)'["REF:" D
.. NEW LOW,HIGH
.. 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[" to "&(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
. ;
. I MPLS,PLS S ^TMP("LRMPLS",$J,PLS,TESTNAME)=""
. I PRNTCODE="" S VALUE=$J(X,8)
. E S @("VALUE="_PRNTCODE)
. ;
. S ^TMP("LR7OGX",$J,"OUTPUT",OUTCNT)=TESTNUM_U_TESTNAME_U_VALUE_U_FLAG_U_UNITS_U_RANGE
. ;
. ; ---- BEGIN IHS/MSC/JS - LR*5.2*1033 - Lookup LOINC CODE, add $P15 to ^TMP data -- 7/11/13
. I +$G(TESTNUM) I +$G(SPEC) D
. . N IEN,IENS,LOINC
. . S IEN=TESTNUM,IENS=SPEC_","_IEN_","
. . S LOINC=$$GET1^DIQ(60.01,IENS,95.3)
. . I $G(LOINC) S $P(^TMP("LR7OGX",$J,"OUTPUT",OUTCNT),"^",15)=LOINC
. ; ---- END IHS/MSC/JS - LR*5.2*1033 - Lookup LOINC CODE, add $P15 to ^TMP data -- 7/11/13
. ;
. S OUTCNT=OUTCNT+1
S $P(^TMP("LR7OGX",$J,"OUTPUT",1),U)=TCNT ;TCNT must be correct to display all values
;
D SPECCOND ; IHS/MSC/MKK - LR*5.2*1033
;
S ^TMP("LR7OGX",$J,"OUTPUT",OUTCNT)=" ",OUTCNT=OUTCNT+1
D LABARRT ; IHS/MSC/MKK - LR*5.2*1039
; S ^TMP("LR7OGX",$J,"OUTPUT",OUTCNT)="Report Released Date/Time: "_$$FMTE^XLFDT($P(ZERO,"^",3),"M"),OUTCNT=OUTCNT+1
S ^TMP("LR7OGX",$J,"OUTPUT",OUTCNT)="Report Released Date/Time: "_$$UP^XLFSTR($$FMTE^XLFDT($P(ZERO,"^",3),"5MPZ")),OUTCNT=OUTCNT+1 ; IHS/MSC/MKK - LR*5.2*1039
;
S (CNT,PORDER)=0
F S PORDER=$O(^TMP("LR7OG",$J,"TP",CDT,PORDER)) Q:PORDER'>0 S DATA=^(PORDER) D
. I $O(^TMP("LR7OG",$J,"TP",CDT,PORDER,0))>0 D
. . S TESTNAME=$P(DATA,U,3)
. . S INTP=0
. . F S INTP=+$O(^TMP("LR7OG",$J,"TP",CDT,PORDER,INTP)) Q:INTP<1 D
. . . S LINE=TESTNAME_" Eval: "_^TMP("LR7OG",$J,"TP",CDT,PORDER,INTP)
. . . S CNT=CNT+1 S:CNT=1 ^TMP("LR7OGX",$J,"OUTPUT",OUTCNT)=" ",OUTCNT=OUTCNT+1
. . . S ^TMP("LR7OGX",$J,"OUTPUT",OUTCNT)=LINE
. . . S OUTCNT=OUTCNT+1
;
I $D(^TMP("LR7OG",$J,"TP",CDT,"C")) D
. S ^TMP("LR7OGX",$J,"OUTPUT",OUTCNT)=" ",OUTCNT=OUTCNT+1
. S ^TMP("LR7OGX",$J,"OUTPUT",OUTCNT)="Comment: "
. S OUTCNT=OUTCNT+1,CMNT=0
. F S CMNT=+$O(^TMP("LR7OG",$J,"TP",CDT,"C",CMNT)) Q:CMNT<1 S LINE=^(CMNT) D
. . S ^TMP("LR7OGX",$J,"OUTPUT",OUTCNT)=" "_LINE
. . S OUTCNT=OUTCNT+1
;
D PLS
;S ^TMP("LR7OGX",$J,"OUTPUT",OUTCNT)="Report Released Date/Time: "_$$FMTE^XLFDT($P(ZERO,"^",3),"M"),OUTCNT=OUTCNT+1
Q
;
;
PLS ; List performing laboratories
; If multiple performing labs then list tests associated with each lab.
;
N CNT,LINE,LRPLS,X
N STR,COUNTY,COUNTRY,ICOUNTRY ; IHS/MSC/MKK - LR*5.2*1033
;
S (CNT,LRPLS)=0
F S LRPLS=$O(^TMP("LRPLS",$J,LRPLS)) Q:LRPLS<1 D
. S:CNT=0 ^TMP("LR7OGX",$J,"OUTPUT",OUTCNT)=" ",OUTCNT=OUTCNT+1
. I $D(^TMP("LRMPLS",$J,LRPLS)) D
. . S TESTNAME="",LINE="For test(s): "
. . F S TESTNAME=$O(^TMP("LRMPLS",$J,LRPLS,TESTNAME)) Q:TESTNAME="" D
. . . I ($L(LINE)+$L(TESTNAME))>240 D
. . . . S ^TMP("LR7OGX",$J,"OUTPUT",OUTCNT)=LINE
. . . . S OUTCNT=OUTCNT+1,LINE=""
. . . S LINE=LINE_TESTNAME_", "
. . S ^TMP("LR7OGX",$J,"OUTPUT",OUTCNT)=LINE,OUTCNT=OUTCNT+1
. S LINE=$$NAME^XUAF4(LRPLS)
. S X=$$PADD^XUAF4(LRPLS)
. S LINE=LINE_" "_$P(X,U)_" "_$P(X,U,2)_", "_$P(X,U,3)_" "_$P(X,U,4)
. S ^TMP("LR7OGX",$J,"OUTPUT",OUTCNT)="Performing Lab: "_LINE
. S OUTCNT=OUTCNT+1,CNT=CNT+1
. ; ----- 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")
. S ^TMP("LR7OGX",$J,"OUTPUT",OUTCNT)=LINE
. S OUTCNT=OUTCNT+1,CNT=CNT+1
. ; ----- END IHS/MSC/MKK - LR*5.2*1033
;
K ^TMP("LRPLS",$J),^TMP("LRMPLS",$J)
Q
;
; ----- 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 ; If RESULT has no numeric part: restore to original RESULT & skip
;
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
SPECCOND ; EP
NEW SPECCOND
;
S SPECCOND=$P($G(^LR(+LRDFN,"CH",+IDT,"IHS")),"^")
Q:$L(SPECCOND)<1
;
S ^TMP("LR7OGX",$J,"OUTPUT",OUTCNT)=" ",OUTCNT=OUTCNT+1
S ^TMP("LR7OGX",$J,"OUTPUT",OUTCNT)="Specimen Condition:"_SPECCOND,OUTCNT=OUTCNT+1
Q
; ----- END IHS/MSC/MKK - LR*5.2*1033
;
; ----- BEGIN IHS/MSC/MKK - LR*5.2*1039
LABARRT ; EP - Lab Arrival Time
NEW LABARRT,LRAA,LRAD,LRAN,LRIDT,LRSS,UID,X
;
Q:+$G(LRDFN)<1
;
S LRIDT=+$G(CNIDT)
Q:LRIDT<1
;
S LRSS=$G(LABSUB)
Q:LRSS=""
;
S UID=+$G(^LR(LRDFN,LRSS,LRIDT,"ORU"))
Q:UID<1
;
S X=$Q(^LRO(68,"C",UID,0))
Q:$QS(X,3)'=UID
;
S LRAA=+$QS(X,4),LRAD=+$QS(X,5),LRAN=+$QS(X,6)
Q:LRAA<1!(LRAD<1)!(LRAN<1)
;
S LABARRT=$$GET1^DIQ(68.02,LRAN_","_LRAD_","_LRAA,12,"I")
Q:+LABARRT<1
;
S ^TMP("LR7OGX",$J,"OUTPUT",OUTCNT)=" Lab Arrival Date/Time: "_$$UP^XLFSTR($$FMTE^XLFDT(LABARRT,"5MPZ"))
S OUTCNT=OUTCNT+1
Q
; ----- END IHS/MSC/MKK - LR*5.2*1039
LR7OGMG ;VA/DALOI/STAFF- Interim report rpc memo grid ; 03-Jul-2014 07:41 ; MKK
+1 ;;5.2;LAB SERVICE;**187,230,1018,286,1027,331,364,395,1031,1033,1039**;NOV 1, 1997;Build 146
+2 ;
GRID(OUTCNT) ; from LR7OGMC
+1 NEW ACC,AGE,CDT,CMNT,CNT,DATA,DOC,FLAG,IDT,INTP,LINE,LRCW,LRX,MPLS,PLS,PORDER,PRNTCODE,RANGE,SEX,SPEC,SUB,TCNT,TESTNAME,TESTNUM
+2 NEW UNITS,VALUE,X,ZERO,INEXACT,DISPDATE
+3 ; the variables AGE, SEX, LRCW, and X are used withing the lab's print codes and ref ranges
+4 KILL ^TMP("LRMPLS",$JOB)
+5 SET AGE=$PIECE(^TMP("LR7OG",$JOB,"G"),U,4)
SET SEX=$PIECE(^("G"),U,5)
SET LRCW=$PIECE(^("G"),U,6)
+6 SET CDT=+$ORDER(^TMP("LR7OG",$JOB,"TP",0))
IF 'CDT
QUIT
+7 SET IDT=9999999-CDT
+8 SET ZERO=$SELECT($DATA(^TMP("LR7OG",$JOB,"TP",CDT))#2:^(CDT),1:"")
+9 SET SPEC=+$PIECE(ZERO,U,5)
+10 SET INEXACT=$PIECE(ZERO,U,2)
SET DISPDATE=$SELECT(INEXACT:CDT\1,1:CDT)
+11 SET DOC=$$NAME^LR7OGMP(+$PIECE(ZERO,U,10))
+12 SET ACC=$PIECE(ZERO,U,6)
+13 SET $PIECE(^TMP("LR7OGX",$JOB,"OUTPUT",1),U,4,6)=SPEC_U_$PIECE($GET(^LAB(61,SPEC,0)),U)_U_ACC_U_DOC
+14 SET $PIECE(^TMP("LR7OGX",$JOB,"OUTPUT",1),U,10)=DISPDATE
+15 SET (TCNT,MPLS,PORDER,PLS)=0
+16 SET PLS=$ORDER(^TMP("LRPLS",$JOB,0))
+17 ; multiple performing labs
IF $ORDER(^TMP("LRPLS",$JOB,PLS))
SET MPLS=1
+18 FOR
SET PORDER=$ORDER(^TMP("LR7OG",$JOB,"TP",CDT,PORDER))
IF PORDER'>0
QUIT
SET DATA=^(PORDER)
Begin DoDot:1
+19 IF $PIECE(DATA,U,7)=""
QUIT
+20 SET TCNT=TCNT+1
+21 SET TESTNUM=+DATA
SET TESTNAME=$PIECE(DATA,U,2)
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 PLS=$PIECE(DATA,U,11)
+22 ;
+23 ; ----- BEGIN IHS/MSC/MKK - LR*5.2*1031
+24 ; NEW LOW,HIGH
+25 ; S LOW=$$TRIM^XLFSTR($P($G(RANGE),"-"),"LR"," ")
+26 ; S HIGH=$$TRIM^XLFSTR($P($G(RANGE),"-",2),"LR"," ")
+27 ; D:$L(LOW) ZEROFIX(TESTNUM,.LOW)
+28 ; D:$L(HIGH) ZEROFIX(TESTNUM,.HIGH)
+29 ; I $L(LOW)!($L(HIGH)) S RANGE=$$EN^LRLRRVF(LOW,HIGH)
+30 ; S ^BLR7OGMG("LR7OGMG",$J,"DID IT")=LOW_"^"_HIGH_"^"_RANGE
+31 ; K LOW,HIGH
+32 ; ----- END IHS/MSC/MKK - LR*5.2*1031
+33 ;
+34 ; ----- BEGIN IHS/MSC/MKK - LR*5.2*1033
+35 IF $$UP^XLFSTR(RANGE)'["REF:"
Begin DoDot:2
+36 NEW LOW,HIGH
+37 SET LOW=$$TRIM^XLFSTR($PIECE($GET(RANGE),"-"),"LR"," ")
+38 SET HIGH=$$TRIM^XLFSTR($PIECE($GET(RANGE),"-",2),"LR"," ")
+39 IF $LENGTH(LOW)
DO ZEROFIX(TESTNUM,.LOW)
+40 IF $LENGTH(HIGH)
DO ZEROFIX(TESTNUM,.HIGH)
+41 IF $LENGTH(LOW)!($LENGTH(HIGH))
SET RANGE=$$EN^LRLRRVF(LOW,HIGH)
End DoDot:2
+42 IF RANGE[" to "&(RANGE["Ref: ")
SET RANGE=$PIECE(RANGE,"Ref: ",2)
+43 ; I RANGE["Ref:" S RANGE=$TR($P(RANGE,"Ref: ",2),"=") ; MU2 Only
+44 ; ----- END IHS/MSC/MKK - LR*5.2*1033
+45 ;
+46 IF MPLS
IF PLS
SET ^TMP("LRMPLS",$JOB,PLS,TESTNAME)=""
+47 IF PRNTCODE=""
SET VALUE=$JUSTIFY(X,8)
+48 IF '$TEST
SET @("VALUE="_PRNTCODE)
+49 ;
+50 SET ^TMP("LR7OGX",$JOB,"OUTPUT",OUTCNT)=TESTNUM_U_TESTNAME_U_VALUE_U_FLAG_U_UNITS_U_RANGE
+51 ;
+52 ; ---- BEGIN IHS/MSC/JS - LR*5.2*1033 - Lookup LOINC CODE, add $P15 to ^TMP data -- 7/11/13
+53 IF +$GET(TESTNUM)
IF +$GET(SPEC)
Begin DoDot:2
+54 NEW IEN,IENS,LOINC
+55 SET IEN=TESTNUM
SET IENS=SPEC_","_IEN_","
+56 SET LOINC=$$GET1^DIQ(60.01,IENS,95.3)
+57 IF $GET(LOINC)
SET $PIECE(^TMP("LR7OGX",$JOB,"OUTPUT",OUTCNT),"^",15)=LOINC
End DoDot:2
+58 ; ---- END IHS/MSC/JS - LR*5.2*1033 - Lookup LOINC CODE, add $P15 to ^TMP data -- 7/11/13
+59 ;
+60 SET OUTCNT=OUTCNT+1
End DoDot:1
+61 ;TCNT must be correct to display all values
SET $PIECE(^TMP("LR7OGX",$JOB,"OUTPUT",1),U)=TCNT
+62 ;
+63 ; IHS/MSC/MKK - LR*5.2*1033
DO SPECCOND
+64 ;
+65 SET ^TMP("LR7OGX",$JOB,"OUTPUT",OUTCNT)=" "
SET OUTCNT=OUTCNT+1
+66 ; IHS/MSC/MKK - LR*5.2*1039
DO LABARRT
+67 ; S ^TMP("LR7OGX",$J,"OUTPUT",OUTCNT)="Report Released Date/Time: "_$$FMTE^XLFDT($P(ZERO,"^",3),"M"),OUTCNT=OUTCNT+1
+68 ; IHS/MSC/MKK - LR*5.2*1039
SET ^TMP("LR7OGX",$JOB,"OUTPUT",OUTCNT)="Report Released Date/Time: "_$$UP^XLFSTR($$FMTE^XLFDT($PIECE(ZERO,"^",3),"5MPZ"))
SET OUTCNT=OUTCNT+1
+69 ;
+70 SET (CNT,PORDER)=0
+71 FOR
SET PORDER=$ORDER(^TMP("LR7OG",$JOB,"TP",CDT,PORDER))
IF PORDER'>0
QUIT
SET DATA=^(PORDER)
Begin DoDot:1
+72 IF $ORDER(^TMP("LR7OG",$JOB,"TP",CDT,PORDER,0))>0
Begin DoDot:2
+73 SET TESTNAME=$PIECE(DATA,U,3)
+74 SET INTP=0
+75 FOR
SET INTP=+$ORDER(^TMP("LR7OG",$JOB,"TP",CDT,PORDER,INTP))
IF INTP<1
QUIT
Begin DoDot:3
+76 SET LINE=TESTNAME_" Eval: "_^TMP("LR7OG",$JOB,"TP",CDT,PORDER,INTP)
+77 SET CNT=CNT+1
IF CNT=1
SET ^TMP("LR7OGX",$JOB,"OUTPUT",OUTCNT)=" "
SET OUTCNT=OUTCNT+1
+78 SET ^TMP("LR7OGX",$JOB,"OUTPUT",OUTCNT)=LINE
+79 SET OUTCNT=OUTCNT+1
End DoDot:3
End DoDot:2
End DoDot:1
+80 ;
+81 IF $DATA(^TMP("LR7OG",$JOB,"TP",CDT,"C"))
Begin DoDot:1
+82 SET ^TMP("LR7OGX",$JOB,"OUTPUT",OUTCNT)=" "
SET OUTCNT=OUTCNT+1
+83 SET ^TMP("LR7OGX",$JOB,"OUTPUT",OUTCNT)="Comment: "
+84 SET OUTCNT=OUTCNT+1
SET CMNT=0
+85 FOR
SET CMNT=+$ORDER(^TMP("LR7OG",$JOB,"TP",CDT,"C",CMNT))
IF CMNT<1
QUIT
SET LINE=^(CMNT)
Begin DoDot:2
+86 SET ^TMP("LR7OGX",$JOB,"OUTPUT",OUTCNT)=" "_LINE
+87 SET OUTCNT=OUTCNT+1
End DoDot:2
End DoDot:1
+88 ;
+89 DO PLS
+90 ;S ^TMP("LR7OGX",$J,"OUTPUT",OUTCNT)="Report Released Date/Time: "_$$FMTE^XLFDT($P(ZERO,"^",3),"M"),OUTCNT=OUTCNT+1
+91 QUIT
+92 ;
+93 ;
PLS ; List performing laboratories
+1 ; If multiple performing labs then list tests associated with each lab.
+2 ;
+3 NEW CNT,LINE,LRPLS,X
+4 ; IHS/MSC/MKK - LR*5.2*1033
NEW STR,COUNTY,COUNTRY,ICOUNTRY
+5 ;
+6 SET (CNT,LRPLS)=0
+7 FOR
SET LRPLS=$ORDER(^TMP("LRPLS",$JOB,LRPLS))
IF LRPLS<1
QUIT
Begin DoDot:1
+8 IF CNT=0
SET ^TMP("LR7OGX",$JOB,"OUTPUT",OUTCNT)=" "
SET OUTCNT=OUTCNT+1
+9 IF $DATA(^TMP("LRMPLS",$JOB,LRPLS))
Begin DoDot:2
+10 SET TESTNAME=""
SET LINE="For test(s): "
+11 FOR
SET TESTNAME=$ORDER(^TMP("LRMPLS",$JOB,LRPLS,TESTNAME))
IF TESTNAME=""
QUIT
Begin DoDot:3
+12 IF ($LENGTH(LINE)+$LENGTH(TESTNAME))>240
Begin DoDot:4
+13 SET ^TMP("LR7OGX",$JOB,"OUTPUT",OUTCNT)=LINE
+14 SET OUTCNT=OUTCNT+1
SET LINE=""
End DoDot:4
+15 SET LINE=LINE_TESTNAME_", "
End DoDot:3
+16 SET ^TMP("LR7OGX",$JOB,"OUTPUT",OUTCNT)=LINE
SET OUTCNT=OUTCNT+1
End DoDot:2
+17 SET LINE=$$NAME^XUAF4(LRPLS)
+18 SET X=$$PADD^XUAF4(LRPLS)
+19 SET LINE=LINE_" "_$PIECE(X,U)_" "_$PIECE(X,U,2)_", "_$PIECE(X,U,3)_" "_$PIECE(X,U,4)
+20 SET ^TMP("LR7OGX",$JOB,"OUTPUT",OUTCNT)="Performing Lab: "_LINE
+21 SET OUTCNT=OUTCNT+1
SET CNT=CNT+1
+22 ; ----- BEGIN IHS/MSC/MKK - LR*5.2*1033
+23 SET STR=$GET(^TMP("LRPLS",$JOB,LRPLS))
+24 IF $LENGTH(STR)<1
QUIT
+25 SET COUNTY=$PIECE(STR,"^")
SET COUNTRY=+$PIECE(STR,"^",2)
+26 SET LINE=$JUSTIFY("",8)_$$LJ^XLFSTR("County:"_COUNTY,15)
+27 IF COUNTRY
SET LINE=LINE_"Country:"_$$GET1^DIQ(779.004,COUNTRY,"CODE")
+28 SET ^TMP("LR7OGX",$JOB,"OUTPUT",OUTCNT)=LINE
+29 SET OUTCNT=OUTCNT+1
SET CNT=CNT+1
+30 ; ----- END IHS/MSC/MKK - LR*5.2*1033
End DoDot:1
+31 ;
+32 KILL ^TMP("LRPLS",$JOB),^TMP("LRMPLS",$JOB)
+33 QUIT
+34 ;
+35 ; ----- 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 ; If RESULT has no numeric part: restore to original RESULT & skip
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
SPECCOND ; EP
+1 NEW SPECCOND
+2 ;
+3 SET SPECCOND=$PIECE($GET(^LR(+LRDFN,"CH",+IDT,"IHS")),"^")
+4 IF $LENGTH(SPECCOND)<1
QUIT
+5 ;
+6 SET ^TMP("LR7OGX",$JOB,"OUTPUT",OUTCNT)=" "
SET OUTCNT=OUTCNT+1
+7 SET ^TMP("LR7OGX",$JOB,"OUTPUT",OUTCNT)="Specimen Condition:"_SPECCOND
SET OUTCNT=OUTCNT+1
+8 QUIT
+9 ; ----- END IHS/MSC/MKK - LR*5.2*1033
+10 ;
+11 ; ----- BEGIN IHS/MSC/MKK - LR*5.2*1039
LABARRT ; EP - Lab Arrival Time
+1 NEW LABARRT,LRAA,LRAD,LRAN,LRIDT,LRSS,UID,X
+2 ;
+3 IF +$GET(LRDFN)<1
QUIT
+4 ;
+5 SET LRIDT=+$GET(CNIDT)
+6 IF LRIDT<1
QUIT
+7 ;
+8 SET LRSS=$GET(LABSUB)
+9 IF LRSS=""
QUIT
+10 ;
+11 SET UID=+$GET(^LR(LRDFN,LRSS,LRIDT,"ORU"))
+12 IF UID<1
QUIT
+13 ;
+14 SET X=$QUERY(^LRO(68,"C",UID,0))
+15 IF $QSUBSCRIPT(X,3)'=UID
QUIT
+16 ;
+17 SET LRAA=+$QSUBSCRIPT(X,4)
SET LRAD=+$QSUBSCRIPT(X,5)
SET LRAN=+$QSUBSCRIPT(X,6)
+18 IF LRAA<1!(LRAD<1)!(LRAN<1)
QUIT
+19 ;
+20 SET LABARRT=$$GET1^DIQ(68.02,LRAN_","_LRAD_","_LRAA,12,"I")
+21 IF +LABARRT<1
QUIT
+22 ;
+23 SET ^TMP("LR7OGX",$JOB,"OUTPUT",OUTCNT)=" Lab Arrival Date/Time: "_$$UP^XLFSTR($$FMTE^XLFDT(LABARRT,"5MPZ"))
+24 SET OUTCNT=OUTCNT+1
+25 QUIT
+26 ; ----- END IHS/MSC/MKK - LR*5.2*1039
