- 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 ;
