BTIULO11 ;IHS/ITSC/LJF - IHS OBJECTS ADDED IN PATCHES;26-Mar-2014 17:11;DU
;;1.0;TEXT INTEGRATION UTILITIES;**1006,1012,1013**;NOV 04, 2004;Build 33
;IHS/MSC/MGH line up number of labs and only display test name
;
NLAB(DFN,TIUTST,TIUCNT) ;EP; -- returns last # of current lab result for single test;PATCH 1001
; TIUTST = lab test name; TIUCNT = # of test results to return
;IHS/CIA/MGH Modified to only display the test name
NEW LAB,ARR,CAPTION,VDT,IEN,X,TIU,LINE,CNT,DATA,LGTH,DATE,Y
K ^TMP("BTIULO",$J)
S LAB=$O(^LAB(60,"B",TIUTST,0)) I LAB="" Q ""
S CAPTION=$E(TIUTST,1,30)_":"
S (VDT,CNT)=0
F S VDT=$O(^AUPNVLAB("AA",DFN,LAB,VDT)) Q:('VDT)!(CNT>100) D
. S IEN=0
. F S IEN=$O(^AUPNVLAB("AA",DFN,LAB,VDT,IEN)) Q:'IEN!(CNT>100) D
.. K TIU D ENP^XBDIQ1(9000010.09,IEN,".03:.05;1109;1201","TIU(")
.. Q:TIU(.04)="" ;skip if not resulted
.. S DATE=$S(TIU(1201)]"":TIU(1201),1:TIU(.03))
.. S CNT=CNT+1 ;increment counter
.. S DATA=" "_DATE
.. S ARR(DATE,IEN)=$J(TIU(.04),8)_" "_TIU(.05)
S CNT=0,DATE=""
;IHS/MSC/MGH patch 1006 change to check for CNT inside a date
F S DATE=$O(ARR(DATE),-1) Q:DATE=""!(CNT=TIUCNT) D
.S IEN="" F S IEN=$O(ARR(DATE,IEN),-1) Q:'IEN!(CNT=TIUCNT) D
.. S LINE=$G(ARR(DATE,IEN)),CNT=CNT+1
.. S Y=$S(CNT=1:CAPTION,1:$$SP($L(CAPTION)))
.. S ^TMP("BTIULO",$J,CNT,0)=Y_LINE ;
I '$D(^TMP("BTIULO",$J)) S ^TMP("BTIULO",$J,1,0)="No Results Found"
Q "~@^TMP(""BTIULO"",$J)"
;
;
PAD(DATA,LENGTH) ; -- SUBRTN to pad length of data
Q $E(DATA_$$REPEAT^XLFSTR(" ",LENGTH),1,LENGTH)
;
SP(NUM) ; -- SUBRTN to pad spaces
Q $$PAD(" ",NUM)
ABORH(DFN) ; EP Get the blood type of patient
N ABO,RH,LRDFN,DATA
S LRDFN=$P($G(^DPT(DFN,"LR")),U,1)
I LRDFN="" S DATA="No lab data on file"
I LRDFN'="" D
.S ABO=$P($G(^LR(LRDFN,0)),U,5)
.S RH=$P($G(^LR(LRDFN,0)),U,6)
.I ABO=""&(RH="") S DATA="No blood type on file"
.E S DATA="Blood Type: "_ABO_" "_RH
Q DATA
CLIA(DFN,TIUTST,TIUCNT) ;EP; -- returns last # of current lab result for single test
; TIUTST = lab test name; TIUCNT = # of test results to return
; Returns CLIA data for each lab
NEW LAB,CAPTION,VDT,IEN,X,TIU,LINE,CNT,DATA,LGTH,ARR,DATE,DATE2,LCNT,ERR,UNIT
N LO,HI,SPEC,PRV,VDATE,RESDT,RES,IEN2,COMM,COMM2,COMM3
K ^TMP("BTIULO",$J)
S TIUCNT=$G(TIUCNT)
S LAB=$O(^LAB(60,"B",TIUTST,0)) I LAB="" Q ""
S CAPTION="Last "_TIUCNT_" "_$E(TIUTST,1,30)_": "
S (VDT,CNT)=0
F S VDT=$O(^AUPNVLAB("AA",DFN,LAB,VDT)) Q:('VDT)!(CNT=TIUCNT) D
. S IEN=0
. F S IEN=$O(^AUPNVLAB("AA",DFN,LAB,VDT,IEN)) Q:'IEN!(CNT=TIUCNT) D
.. K TIU ;D ENP^XBDIQ1(9000010.09,IEN,".03:.05;1109;1201","TIU(")
.. D GETS^DIQ(9000010.09,IEN_",","**","IE","TIU(","ERR")
.. S IEN2=IEN_","
.. S RES=$G(TIU(9000010.09,IEN2,.04,"E"))
.. Q:RES="" ;skip if not resulted
.. S DATE=TIU(9000010.09,IEN2,1201,"I")
.. S VDATE=TIU(9000010.09,IEN2,.03,"I")
.. S DATE2=$S(DATE]"":TIU(9000010.09,IEN2,1201,"E"),1:TIU(900010.09,IEN2,.03,"E"))
.. S ABN=$G(TIU(9000010.09,IEN2,.05,"E"))
.. S UNIT=$G(TIU(9000010.09,IEN2,1101,"E"))
.. S LO=$G(TIU(9000010.09,IEN2,1104,"E"))
.. S HI=$G(TIU(9000010.09,IEN2,1105,"E"))
.. S SPEC=$G(TIU(9000010.09,IEN2,1103,"E"))
.. S PRV=$G(TIU(9000010.09,IEN2,1202,"E"))
.. S RESDT=$G(TIU(9000010.09,IEN2,1212,"E"))
.. S COMM=$G(TIU(9000010.09,IEN2,1301,"E"))
.. S COMM2=$G(TIU(9000010.09,IEN2,1302,"E"))
.. S COMM3=$G(TIU(9000010.09,IEN2,1303,"E"))
.. S CNT=CNT+1 ;increment counter
.. S LGTH=$L($G(TIU(9000010.09,IEN2,.05))) ;PATCH 1003
.. S ARR(DATE,IEN)=RES_" "_UNIT_" "_ABN_U_DATE2_U_LO_U_HI_U_SPEC_U_RESDT_U_COMM_U_COMM2_U_COMM3_U_PRV
S CNT=0,LCNT=0,DATE=""
;IHS/MSC/MGH patch 1006 and 1010 change to check for CNT inside a date
N VFILENUM,ARRAY,ABN,PATIENT
S PATIENT=$$GET1^DIQ(2,DFN,.01)
F S DATE=$O(ARR(DATE),-1) Q:DATE=""!(CNT>=TIUCNT) D
. S IEN="" F S IEN=$O(ARR(DATE,IEN)) Q:'IEN!(CNT>=TIUCNT) D
.. S LINE=$G(ARR(DATE,IEN)),CNT=CNT+1,LCNT=LCNT+1
.. S Y=$S(CNT=1:CAPTION,1:$$SP($L(CAPTION)))
.. S ^TMP("BTIULO",$J,LCNT,0)=Y_"Result: "_$P(LINE,U,1)
.. I $P(LINE,U,3)'=""!($P(LINE,U,4)'=1) D
... S LCNT=LCNT+1
... S ^TMP("BTIULO",$J,LCNT,0)=$$SP($L(CAPTION))_"Ref Range LO: "_$P(LINE,U,3)_" HI: "_$P(LINE,U,4)
.. I $P(LINE,U,5)'="" S LCNT=LCNT+1,^TMP("BTIULO",$J,LCNT,0)=$$SP($L(CAPTION))_"Specimen: "_$P(LINE,U,5)
.. I $P(LINE,U,2)'="" S LCNT=LCNT+1,^TMP("BTIULO",$J,LCNT,0)=$$SP($L(CAPTION))_"Collection Date: "_$P(LINE,U,2)
.. I $P(LINE,U,6)'="" S LCNT=LCNT+1,^TMP("BTIULO",$J,LCNT,0)=$$SP($L(CAPTION))_"Result Date: "_$P(LINE,U,6)
.. S LCNT=LCNT+1,^TMP("BTIULO",$J,LCNT,0)=$$SP($L(CAPTION))_"Patient: "_PATIENT
.. I $P(LINE,U,10)'="" S LCNT=LCNT+1,^TMP("BTIULO",$J,LCNT,0)=$$SP($L(CAPTION))_"Orderer: "_$P(LINE,U,10)
.. I $P(LINE,U,7)'="" S LCNT=LCNT+1,^TMP("BTIULO",$J,LCNT,0)=$$SP($L(CAPTION))_($P(LINE,U,7))
.. I $P(LINE,U,8)'="" S LCNT=LCNT+1,^TMP("BTIULO",$J,LCNT,0)=$$SP($L(CAPTION))_$P(LINE,U,8)
.. I $P(LINE,U,9)'="" S LCNT=LCNT+1,^TMP("BTIULO",$J,LCNT,0)=$$SP($L(CAPTION))_$P(LINE,U,9)
.. ;Do new comments 1013
..I $D(^AUPNVLAB(IEN,21))>1 D
..S LCNT=LCNT+1,^TMP("BTIULO",$J,LCNT,0)=$$SP($L(CAPTION))_"COMMENTS:"
.. S X=0 F S X=$O(^AUPNVLAB(IEN,21,X)) Q:'+X D
...S LCNT=LCNT+1,^TMP("BTIULO",$J,LCNT,0)=$$SP($L(CAPTION))_$G(^AUPNVLAB(IEN,21,X,0))
.. S X="BLRREFLA" X ^%ZOSF("TEST") I $T D
... S VFILENUM=9000010.09
... D PCCRLADR^BLRREFLA(VFILENUM,IEN,.ARRAY)
... S LCNT=LCNT+1
... S ^TMP("BTIULO",$J,LCNT,0)=$$SP($L(CAPTION))_"Source: "_ARRAY("NAME")
... S LCNT=LCNT+1
... S ^TMP("BTIULO",$J,LCNT,0)=$$SP($L(CAPTION))_"Addr: "_ARRAY("ST1")
... S LCNT=LCNT+1
... S ^TMP("BTIULO",$J,LCNT,0)=$$SP($L(CAPTION))_ARRAY("CITY")_", "_ARRAY("STATE")_" "_ARRAY("ZIP")
..S LCNT=LCNT+1,^TMP("BTIULO",$J,LCNT,0)=""
I '$D(^TMP("BTIULO",$J)) S ^TMP("BTIULO",$J,1,0)=CAPTION_"No Results Found"
Q "~@^TMP(""BTIULO"",$J)"
;
BTIULO11 ;IHS/ITSC/LJF - IHS OBJECTS ADDED IN PATCHES;26-Mar-2014 17:11;DU
+1 ;;1.0;TEXT INTEGRATION UTILITIES;**1006,1012,1013**;NOV 04, 2004;Build 33
+2 ;IHS/MSC/MGH line up number of labs and only display test name
+3 ;
NLAB(DFN,TIUTST,TIUCNT) ;EP; -- returns last # of current lab result for single test;PATCH 1001
+1 ; TIUTST = lab test name; TIUCNT = # of test results to return
+2 ;IHS/CIA/MGH Modified to only display the test name
+3 NEW LAB,ARR,CAPTION,VDT,IEN,X,TIU,LINE,CNT,DATA,LGTH,DATE,Y
+4 KILL ^TMP("BTIULO",$JOB)
+5 SET LAB=$ORDER(^LAB(60,"B",TIUTST,0))
IF LAB=""
QUIT ""
+6 SET CAPTION=$EXTRACT(TIUTST,1,30)_":"
+7 SET (VDT,CNT)=0
+8 FOR
SET VDT=$ORDER(^AUPNVLAB("AA",DFN,LAB,VDT))
IF ('VDT)!(CNT>100)
QUIT
Begin DoDot:1
+9 SET IEN=0
+10 FOR
SET IEN=$ORDER(^AUPNVLAB("AA",DFN,LAB,VDT,IEN))
IF 'IEN!(CNT>100)
QUIT
Begin DoDot:2
+11 KILL TIU
DO ENP^XBDIQ1(9000010.09,IEN,".03:.05;1109;1201","TIU(")
+12 ;skip if not resulted
IF TIU(.04)=""
QUIT
+13 SET DATE=$SELECT(TIU(1201)]"":TIU(1201),1:TIU(.03))
+14 ;increment counter
SET CNT=CNT+1
+15 SET DATA=" "_DATE
+16 SET ARR(DATE,IEN)=$JUSTIFY(TIU(.04),8)_" "_TIU(.05)
End DoDot:2
End DoDot:1
+17 SET CNT=0
SET DATE=""
+18 ;IHS/MSC/MGH patch 1006 change to check for CNT inside a date
+19 FOR
SET DATE=$ORDER(ARR(DATE),-1)
IF DATE=""!(CNT=TIUCNT)
QUIT
Begin DoDot:1
+20 SET IEN=""
FOR
SET IEN=$ORDER(ARR(DATE,IEN),-1)
IF 'IEN!(CNT=TIUCNT)
QUIT
Begin DoDot:2
+21 SET LINE=$GET(ARR(DATE,IEN))
SET CNT=CNT+1
+22 SET Y=$SELECT(CNT=1:CAPTION,1:$$SP($LENGTH(CAPTION)))
+23 ;
SET ^TMP("BTIULO",$JOB,CNT,0)=Y_LINE
End DoDot:2
End DoDot:1
+24 IF '$DATA(^TMP("BTIULO",$JOB))
SET ^TMP("BTIULO",$JOB,1,0)="No Results Found"
+25 QUIT "~@^TMP(""BTIULO"",$J)"
+26 ;
+27 ;
PAD(DATA,LENGTH) ; -- SUBRTN to pad length of data
+1 QUIT $EXTRACT(DATA_$$REPEAT^XLFSTR(" ",LENGTH),1,LENGTH)
+2 ;
SP(NUM) ; -- SUBRTN to pad spaces
+1 QUIT $$PAD(" ",NUM)
ABORH(DFN) ; EP Get the blood type of patient
+1 NEW ABO,RH,LRDFN,DATA
+2 SET LRDFN=$PIECE($GET(^DPT(DFN,"LR")),U,1)
+3 IF LRDFN=""
SET DATA="No lab data on file"
+4 IF LRDFN'=""
Begin DoDot:1
+5 SET ABO=$PIECE($GET(^LR(LRDFN,0)),U,5)
+6 SET RH=$PIECE($GET(^LR(LRDFN,0)),U,6)
+7 IF ABO=""&(RH="")
SET DATA="No blood type on file"
+8 IF '$TEST
SET DATA="Blood Type: "_ABO_" "_RH
End DoDot:1
+9 QUIT DATA
CLIA(DFN,TIUTST,TIUCNT) ;EP; -- returns last # of current lab result for single test
+1 ; TIUTST = lab test name; TIUCNT = # of test results to return
+2 ; Returns CLIA data for each lab
+3 NEW LAB,CAPTION,VDT,IEN,X,TIU,LINE,CNT,DATA,LGTH,ARR,DATE,DATE2,LCNT,ERR,UNIT
+4 NEW LO,HI,SPEC,PRV,VDATE,RESDT,RES,IEN2,COMM,COMM2,COMM3
+5 KILL ^TMP("BTIULO",$JOB)
+6 SET TIUCNT=$GET(TIUCNT)
+7 SET LAB=$ORDER(^LAB(60,"B",TIUTST,0))
IF LAB=""
QUIT ""
+8 SET CAPTION="Last "_TIUCNT_" "_$EXTRACT(TIUTST,1,30)_": "
+9 SET (VDT,CNT)=0
+10 FOR
SET VDT=$ORDER(^AUPNVLAB("AA",DFN,LAB,VDT))
IF ('VDT)!(CNT=TIUCNT)
QUIT
Begin DoDot:1
+11 SET IEN=0
+12 FOR
SET IEN=$ORDER(^AUPNVLAB("AA",DFN,LAB,VDT,IEN))
IF 'IEN!(CNT=TIUCNT)
QUIT
Begin DoDot:2
+13 ;D ENP^XBDIQ1(9000010.09,IEN,".03:.05;1109;1201","TIU(")
KILL TIU
+14 DO GETS^DIQ(9000010.09,IEN_",","**","IE","TIU(","ERR")
+15 SET IEN2=IEN_","
+16 SET RES=$GET(TIU(9000010.09,IEN2,.04,"E"))
+17 ;skip if not resulted
IF RES=""
QUIT
+18 SET DATE=TIU(9000010.09,IEN2,1201,"I")
+19 SET VDATE=TIU(9000010.09,IEN2,.03,"I")
+20 SET DATE2=$SELECT(DATE]"":TIU(9000010.09,IEN2,1201,"E"),1:TIU(900010.09,IEN2,.03,"E"))
+21 SET ABN=$GET(TIU(9000010.09,IEN2,.05,"E"))
+22 SET UNIT=$GET(TIU(9000010.09,IEN2,1101,"E"))
+23 SET LO=$GET(TIU(9000010.09,IEN2,1104,"E"))
+24 SET HI=$GET(TIU(9000010.09,IEN2,1105,"E"))
+25 SET SPEC=$GET(TIU(9000010.09,IEN2,1103,"E"))
+26 SET PRV=$GET(TIU(9000010.09,IEN2,1202,"E"))
+27 SET RESDT=$GET(TIU(9000010.09,IEN2,1212,"E"))
+28 SET COMM=$GET(TIU(9000010.09,IEN2,1301,"E"))
+29 SET COMM2=$GET(TIU(9000010.09,IEN2,1302,"E"))
+30 SET COMM3=$GET(TIU(9000010.09,IEN2,1303,"E"))
+31 ;increment counter
SET CNT=CNT+1
+32 ;PATCH 1003
SET LGTH=$LENGTH($GET(TIU(9000010.09,IEN2,.05)))
+33 SET ARR(DATE,IEN)=RES_" "_UNIT_" "_ABN_U_DATE2_U_LO_U_HI_U_SPEC_U_RESDT_U_COMM_U_COMM2_U_COMM3_U_PRV
End DoDot:2
End DoDot:1
+34 SET CNT=0
SET LCNT=0
SET DATE=""
+35 ;IHS/MSC/MGH patch 1006 and 1010 change to check for CNT inside a date
+36 NEW VFILENUM,ARRAY,ABN,PATIENT
+37 SET PATIENT=$$GET1^DIQ(2,DFN,.01)
+38 FOR
SET DATE=$ORDER(ARR(DATE),-1)
IF DATE=""!(CNT>=TIUCNT)
QUIT
Begin DoDot:1
+39 SET IEN=""
FOR
SET IEN=$ORDER(ARR(DATE,IEN))
IF 'IEN!(CNT>=TIUCNT)
QUIT
Begin DoDot:2
+40 SET LINE=$GET(ARR(DATE,IEN))
SET CNT=CNT+1
SET LCNT=LCNT+1
+41 SET Y=$SELECT(CNT=1:CAPTION,1:$$SP($LENGTH(CAPTION)))
+42 SET ^TMP("BTIULO",$JOB,LCNT,0)=Y_"Result: "_$PIECE(LINE,U,1)
+43 IF $PIECE(LINE,U,3)'=""!($PIECE(LINE,U,4)'=1)
Begin DoDot:3
+44 SET LCNT=LCNT+1
+45 SET ^TMP("BTIULO",$JOB,LCNT,0)=$$SP($LENGTH(CAPTION))_"Ref Range LO: "_$PIECE(LINE,U,3)_" HI: "_$PIECE(LINE,U,4)
End DoDot:3
+46 IF $PIECE(LINE,U,5)'=""
SET LCNT=LCNT+1
SET ^TMP("BTIULO",$JOB,LCNT,0)=$$SP($LENGTH(CAPTION))_"Specimen: "_$PIECE(LINE,U,5)
+47 IF $PIECE(LINE,U,2)'=""
SET LCNT=LCNT+1
SET ^TMP("BTIULO",$JOB,LCNT,0)=$$SP($LENGTH(CAPTION))_"Collection Date: "_$PIECE(LINE,U,2)
+48 IF $PIECE(LINE,U,6)'=""
SET LCNT=LCNT+1
SET ^TMP("BTIULO",$JOB,LCNT,0)=$$SP($LENGTH(CAPTION))_"Result Date: "_$PIECE(LINE,U,6)
+49 SET LCNT=LCNT+1
SET ^TMP("BTIULO",$JOB,LCNT,0)=$$SP($LENGTH(CAPTION))_"Patient: "_PATIENT
+50 IF $PIECE(LINE,U,10)'=""
SET LCNT=LCNT+1
SET ^TMP("BTIULO",$JOB,LCNT,0)=$$SP($LENGTH(CAPTION))_"Orderer: "_$PIECE(LINE,U,10)
+51 IF $PIECE(LINE,U,7)'=""
SET LCNT=LCNT+1
SET ^TMP("BTIULO",$JOB,LCNT,0)=$$SP($LENGTH(CAPTION))_($PIECE(LINE,U,7))
+52 IF $PIECE(LINE,U,8)'=""
SET LCNT=LCNT+1
SET ^TMP("BTIULO",$JOB,LCNT,0)=$$SP($LENGTH(CAPTION))_$PIECE(LINE,U,8)
+53 IF $PIECE(LINE,U,9)'=""
SET LCNT=LCNT+1
SET ^TMP("BTIULO",$JOB,LCNT,0)=$$SP($LENGTH(CAPTION))_$PIECE(LINE,U,9)
+54 ;Do new comments 1013
+55 IF $DATA(^AUPNVLAB(IEN,21))>1
Begin DoDot:3
End DoDot:3
+56 SET LCNT=LCNT+1
SET ^TMP("BTIULO",$JOB,LCNT,0)=$$SP($LENGTH(CAPTION))_"COMMENTS:"
+57 SET X=0
FOR
SET X=$ORDER(^AUPNVLAB(IEN,21,X))
IF '+X
QUIT
Begin DoDot:3
+58 SET LCNT=LCNT+1
SET ^TMP("BTIULO",$JOB,LCNT,0)=$$SP($LENGTH(CAPTION))_$GET(^AUPNVLAB(IEN,21,X,0))
End DoDot:3
+59 SET X="BLRREFLA"
XECUTE ^%ZOSF("TEST")
IF $TEST
Begin DoDot:3
+60 SET VFILENUM=9000010.09
+61 DO PCCRLADR^BLRREFLA(VFILENUM,IEN,.ARRAY)
+62 SET LCNT=LCNT+1
+63 SET ^TMP("BTIULO",$JOB,LCNT,0)=$$SP($LENGTH(CAPTION))_"Source: "_ARRAY("NAME")
+64 SET LCNT=LCNT+1
+65 SET ^TMP("BTIULO",$JOB,LCNT,0)=$$SP($LENGTH(CAPTION))_"Addr: "_ARRAY("ST1")
+66 SET LCNT=LCNT+1
+67 SET ^TMP("BTIULO",$JOB,LCNT,0)=$$SP($LENGTH(CAPTION))_ARRAY("CITY")_", "_ARRAY("STATE")_" "_ARRAY("ZIP")
End DoDot:3
+68 SET LCNT=LCNT+1
SET ^TMP("BTIULO",$JOB,LCNT,0)=""
End DoDot:2
End DoDot:1
+69 IF '$DATA(^TMP("BTIULO",$JOB))
SET ^TMP("BTIULO",$JOB,1,0)=CAPTION_"No Results Found"
+70 QUIT "~@^TMP(""BTIULO"",$J)"
+71 ;
