BKMVF32 ;PRXM/HC/JGH - Reminders From Patient Record and Menu Tree (Functions - 2); Mar 21, 2005 ; 09 Jun 2005 12:37 PM
;;2.2;HIV MANAGEMENT SYSTEM;**2**;Apr 01, 2015;Build 3
QUIT
; KJH - 04/13/2005 - Split from original routine due to size restrictions.
;
POSITIVE(RESULT) ; EP - If the result is positive return a 1 else return a 0.
I $E(RESULT,1)="+" Q 1
I $E(RESULT,1)=">" Q 1
S RESULT=$$UP^XLFSTR(RESULT)
I RESULT="P" Q 1 ; Positive
I RESULT="R" Q 1 ; Reactive
I RESULT="WR" Q 1 ; Weakly Reactive
I RESULT="REACTIVE" Q 1 ; Reactive
I RESULT="WEAKLY REACTIVE" Q 1 ; Weakly Reactive
; Result field contains a word that starts with "POS" or "pos"
N FLG,I
S FLG=0
I $E(RESULT,1,3)="POS" S FLG=1 Q FLG
F I=1:1:$L(RESULT) I $E(RESULT,I)?1P,$E(RESULT,I+1,I+3)="POS" S FLG=1 Q
Q FLG
;I RESULT["POS" Q 1 ; Positive
;Q 0
;
NEGATIVE(RESULT) ; EP - If the result is negative return a 1 else return a 0.
I $E(RESULT,1)="-" Q 1
; **NOTE: Documentation does not specify if "<" is considered negative.
S RESULT=$$UP^XLFSTR(RESULT)
I RESULT="N" Q 1 ; Negative (or Non-Reactive)
I RESULT="NR" Q 1 ; Non-Reactive
I RESULT="NON-REACTIVE" Q 1 ; Non-Reactive
I RESULT="NON REACTIVE" Q 1 ; Non-Reactive
I RESULT="NONREACTIVE" Q 1 ; Non-Reactive
; Result field contains a word that starts with "NEG" or "neg"
N FLG,I
S FLG=0
I $E(RESULT,1,3)="NEG" S FLG=1 Q FLG
F I=1:1:$L(RESULT) I $E(RESULT,I)?1P,$E(RESULT,I+1,I+3)="NEG" S FLG=1 Q
Q FLG
;I RESULT["NEG" Q 1 ; Negative
;Q 0
;
PPDPOS(RESULT) ; EP - If the result is positive return a 1 else return a 0.
; This change is specific to PPD.
S RESULT=$$UP^XLFSTR(RESULT)
I RESULT="P" Q 1 ; Positive
I RESULT="R" Q 1 ; Reactive
I RESULT="WR" Q 1 ; Weakly Reactive
I RESULT="REACTIVE" Q 1 ; Reactive
I RESULT="WEAKLY REACTIVE" Q 1 ; Weakly Reactive
I RESULT="+" Q 1 ; Positive
I RESULT?.N,RESULT>4 Q 1 ; Positive numeric result
; Result field contains a word that starts with "POS" or "pos"
N FLG,I
S FLG=0
I $E(RESULT,1,3)="POS" S FLG=1 Q FLG
F I=1:1:$L(RESULT) I $E(RESULT,I)?1P,$E(RESULT,I+1,I+3)="POS" S FLG=1 Q
Q FLG
;
PPDNEG(RESULT) ; EP - If the result is negative return a 1 else return a 0.
; This change is specific to PPD.
;I $E(RESULT,1)="-" Q 1
; **NOTE: Documentation does not specify if "<" is considered negative.
S RESULT=$$UP^XLFSTR(RESULT)
I RESULT="N" Q 1 ; Negative (or Non-Reactive)
I RESULT="NR" Q 1 ; Non-Reactive
I RESULT="NON-REACTIVE" Q 1 ; Non-Reactive
I RESULT="NON REACTIVE" Q 1 ; Non-Reactive
I RESULT="NONREACTIVE" Q 1 ; Non-Reactive
I RESULT="-" Q 1 ; Negative
I RESULT?1.N,RESULT<5 Q 1 ; Negative numeric result
; Result field contains a word that starts with "NEG" or "neg"
N FLG,I
S FLG=0
I $E(RESULT,1,3)="NEG" S FLG=1 Q FLG
F I=1:1:$L(RESULT) I $E(RESULT,I)?1P,$E(RESULT,I+1,I+3)="NEG" S FLG=1 Q
Q FLG
;
ADDLINE(REM,ARRAY,TEXT,LAST,DUE,LASTTXT) ; EP - Update reminder output array
S ARRAY(REM)=$G(ARRAY(REM))+1
S ARRAY(REM,ARRAY(REM),0)=$G(TEXT)
S ARRAY(REM,ARRAY(REM),"LAST")=$G(LAST)
S ARRAY(REM,ARRAY(REM),"DUE")=$G(DUE)
S ARRAY(REM,ARRAY(REM),"LASTTXT")=$G(LASTTXT)
Q
;
; Check for any positive STD tests (other than the one specified in STD) after LDATE.
; Check for any STD diagnoses (other than the one specified in STD) after LDATE.
; Valid values for STD are "CHLAMYDIA", "GONORRHEA", "SYPHILIS", "TRICHOMONIASIS" and "OTHER".
; NOTE: "TRICHOMONIASIS" and "OTHER" are not likely to be used but are maintained for consistency.
STDS(DFN,STD,LDATE) ;EP
NEW PDATE,PRCTEST,PRCDT,PRC,DDATE,LDATE1
; Use the newer of LDATE or report date minus 365 days.
I $G(BDATE)="" S BDATE=DT
S LDATE1=$$FMADD^XLFDT(BDATE,-365)
I LDATE>LDATE1 S LDATE1=LDATE
S LDATE1=LDATE1\1_".2400" ;Start search on the next day
; Chlamydia (T.3)
I STD'="CHLAMYDIA" D LABCODES(DFN,"BGP CHLAMYDIA TESTS TAX","BGP CHLAMYDIA LOINC CODES","BTPW CHLAMYDIA CPTS","BGP CHLAMYDIA TEST PROCEDURES",LDATE1,"","","",.PDATE) I PDATE'="" Q 1
; Gonorrhea (T.10)
I STD'="GONORRHEA" D LABCODES(DFN,"BKM GONORRHEA TEST TAX","BKM GONORRHEA LOINC CODES","BKM GONORRHEA TESTS CPTS","",LDATE1,"","","",.PDATE) I PDATE'="" Q 1
; Syphilis (T.22)
I STD'="SYPHILIS" D LABCODES(DFN,"BKM RPR TAX","BKM RPR LOINC CODES","BKM RPR CPTS","",LDATE1,"","","",.PDATE) I PDATE'="" Q 1
; Syphilis (T.9)
I STD'="SYPHILIS" D LABCODES(DFN,"BKM FTA-ABS TEST TAX","BKM FTA-ABS LOINC CODES","BKM FTA-ABS CPTS","",LDATE1,"","","",.PDATE) I PDATE'="" Q 1
;PRXM/HC/BHS - 04/19/2006 - Removed per IHS Issue # 1467
; Trichomoniasis (T.24)
;I STD'="TRICHOMONIASIS" D LABCODES(DFN,"BKM TRICH TESTS TAX","BKM TRICH LOINC CODES","","BKM TRICHOMONIASIS DXS",LDATE1,"","","",.PDATE) I PDATE'="" Q 1
;PRXM/HC/KJH - 04/19/2006 - Removed per IHS Issue # 1460, 1464, 1465 and replaced with other POV diagnosis checks below.
; Other STD (DX.9)
;I STD'="OTHER" D LABCODES(DFN,"","","","BKM OTHER STD DXS",LDATE1,"","","",.PDATE) I PDATE'="" Q 1
; Chlamydia (DX.2)
I STD'="CHLAMYDIA" D ICDTAX^BKMIXX1(DFN,"BKM CHLAMYDIA DXS","",LDATE1,"",.DDATE) I DDATE'="" Q 1
; Gonorrhea (DX.4)
I STD'="GONORRHEA" D ICDTAX^BKMIXX1(DFN,"BKM GONORRHEA DXS","",LDATE1,"",.DDATE) I DDATE'="" Q 1
; Syphilis (DX.11)
I STD'="SYPHILIS" D ICDTAX^BKMIXX1(DFN,"BKM SYPHILIS DXS","",LDATE1,"",.DDATE) I DDATE'="" Q 1
; Trichomoniasis (DX.13)
I STD'="TRICHOMONIASIS" D ICDTAX^BKMIXX1(DFN,"BKM TRICHOMONIASIS DXS","",LDATE1,"",.DDATE) I DDATE'="" Q 1
; Other STD (DX.9)
I STD'="OTHER" D ICDTAX^BKMIXX1(DFN,"BKM OTHER STD DXS","",LDATE1,"",.DDATE) I DDATE'="" Q 1
Q 0
;
; This function cycles through the V-Lab file checking
; each lab, CPT4, ICD9, and LOINC associated with a DFN to
; see if each is in an appropriate taxonomy, old enough,
; and if required positive.
;
; DFN is the patient DFN from file 2 or 9000001.
;
; LABT is the text name of the lab taxonomy.
; LOINCT is the text name of the LOINC taxonomy.
; CPTT is the text name of the CPT taxonomy.
; ICDT is the text name of the ICD9 taxonomy.
;
; BDATE is the base (starting) date for the search.
;
; IDATE is the date of the last item (LAB, LOINC, CPT, or ICD) passed by reference.
;
; LDATE is the date of the last LAB passed by reference.
; LR if there is a LDATE then the LR will be equal to the result.
; LV if there is a LDATE then the LV is the V Lab IEN.
;
; PDATE is the date of the last positive LAB passed by reference.
; PR if there is a PDATE then the PR will be equal to the positive result.
; PV if there is a PDATE then the PV is the V Lab IEN.
;
; NDATE is the date of the last negative LAB passed by reference.
; NR if there is a NDATE then the NR will be equal to the negative result.
; NV if there is a NDATE then the NV is the V Lab IEN.
;
LABCODES(DFN,LABT,LOINCT,CPTT,ICDT,BDATE,IDATE,LDATE,LR,PDATE,PR,NDATE,NR,ODATE,OR,OFLG) ;EP
; EP - Retrieve lab codes.
N QDATE,QV,LV,TARGET,LABTEST,LAB,LABDT,RESULT
S LABT=$G(LABT,""),LOINCT=$G(LOINCT,""),CPTT=$G(CPTT,""),ICDT=$G(ICDT,""),OFLG=$G(OFLG,"")
S BDATE=$G(BDATE,""),IDATE=$G(IDATE,""),LDATE=$G(LDATE,""),PDATE=$G(PDATE,""),NDATE=$G(NDATE,""),ODATE=$G(ODATE,"")
S (LV,LR,PR,NR,OR)=""
S TARGET="LABTEST(VSTDT,TEST)"
S QDATE="",QV=""
D LABTAX^BKMIXX(DFN,LABT,"",BDATE,TARGET,.QDATE,.QV)
S IDATE=QDATE,LDATE=QDATE,LV=QV
S QDATE="",QV=""
D LOINC^BKMIXX(DFN,LOINCT,"",BDATE,TARGET,.QDATE,.QV)
I QDATE>IDATE S IDATE=QDATE,LDATE=QDATE,LV=QV
S QDATE="",QV=""
D CPTTAX^BKMIXX(DFN,CPTT,"",BDATE,TARGET,.QDATE,.QV)
I QDATE>IDATE S IDATE=QDATE,LDATE=QDATE,LV=QV
S QDATE="",QV=""
D ICDTAX^BKMIXX1(DFN,ICDT,"",BDATE,TARGET,.QDATE,.QV)
I QDATE>IDATE S IDATE=QDATE,LDATE=QDATE,LV=QV
I LV'="" S LR=LABTEST(LDATE,LV)
S LABDT=""
F S LABDT=$O(LABTEST(LABDT),-1) Q:LABDT="" D I PDATE]"",NDATE]"" Q
. S LAB=""
. F S LAB=$O(LABTEST(LABDT,LAB),-1) Q:LAB="" D I PDATE]"",NDATE]"" Q
. . S RESULT=$P(LABTEST(LABDT,LAB),U)
. . I PDATE="",$$POSITIVE^BKMVF32(RESULT) S PDATE=LABDT,PR=RESULT
. . I NDATE="",$$NEGATIVE^BKMVF32(RESULT) S NDATE=LABDT,NR=RESULT
. . I ODATE="",OFLG'="",@OFLG S ODATE=LABDT,OR=RESULT
. . Q
. Q
Q
BKMVF32 ;PRXM/HC/JGH - Reminders From Patient Record and Menu Tree (Functions - 2); Mar 21, 2005 ; 09 Jun 2005 12:37 PM
+1 ;;2.2;HIV MANAGEMENT SYSTEM;**2**;Apr 01, 2015;Build 3
+2 QUIT
+3 ; KJH - 04/13/2005 - Split from original routine due to size restrictions.
+4 ;
POSITIVE(RESULT) ; EP - If the result is positive return a 1 else return a 0.
+1 IF $EXTRACT(RESULT,1)="+"
QUIT 1
+2 IF $EXTRACT(RESULT,1)=">"
QUIT 1
+3 SET RESULT=$$UP^XLFSTR(RESULT)
+4 ; Positive
IF RESULT="P"
QUIT 1
+5 ; Reactive
IF RESULT="R"
QUIT 1
+6 ; Weakly Reactive
IF RESULT="WR"
QUIT 1
+7 ; Reactive
IF RESULT="REACTIVE"
QUIT 1
+8 ; Weakly Reactive
IF RESULT="WEAKLY REACTIVE"
QUIT 1
+9 ; Result field contains a word that starts with "POS" or "pos"
+10 NEW FLG,I
+11 SET FLG=0
+12 IF $EXTRACT(RESULT,1,3)="POS"
SET FLG=1
QUIT FLG
+13 FOR I=1:1:$LENGTH(RESULT)
IF $EXTRACT(RESULT,I)?1P
IF $EXTRACT(RESULT,I+1,I+3)="POS"
SET FLG=1
QUIT
+14 QUIT FLG
+15 ;I RESULT["POS" Q 1 ; Positive
+16 ;Q 0
+17 ;
NEGATIVE(RESULT) ; EP - If the result is negative return a 1 else return a 0.
+1 IF $EXTRACT(RESULT,1)="-"
QUIT 1
+2 ; **NOTE: Documentation does not specify if "<" is considered negative.
+3 SET RESULT=$$UP^XLFSTR(RESULT)
+4 ; Negative (or Non-Reactive)
IF RESULT="N"
QUIT 1
+5 ; Non-Reactive
IF RESULT="NR"
QUIT 1
+6 ; Non-Reactive
IF RESULT="NON-REACTIVE"
QUIT 1
+7 ; Non-Reactive
IF RESULT="NON REACTIVE"
QUIT 1
+8 ; Non-Reactive
IF RESULT="NONREACTIVE"
QUIT 1
+9 ; Result field contains a word that starts with "NEG" or "neg"
+10 NEW FLG,I
+11 SET FLG=0
+12 IF $EXTRACT(RESULT,1,3)="NEG"
SET FLG=1
QUIT FLG
+13 FOR I=1:1:$LENGTH(RESULT)
IF $EXTRACT(RESULT,I)?1P
IF $EXTRACT(RESULT,I+1,I+3)="NEG"
SET FLG=1
QUIT
+14 QUIT FLG
+15 ;I RESULT["NEG" Q 1 ; Negative
+16 ;Q 0
+17 ;
PPDPOS(RESULT) ; EP - If the result is positive return a 1 else return a 0.
+1 ; This change is specific to PPD.
+2 SET RESULT=$$UP^XLFSTR(RESULT)
+3 ; Positive
IF RESULT="P"
QUIT 1
+4 ; Reactive
IF RESULT="R"
QUIT 1
+5 ; Weakly Reactive
IF RESULT="WR"
QUIT 1
+6 ; Reactive
IF RESULT="REACTIVE"
QUIT 1
+7 ; Weakly Reactive
IF RESULT="WEAKLY REACTIVE"
QUIT 1
+8 ; Positive
IF RESULT="+"
QUIT 1
+9 ; Positive numeric result
IF RESULT?.N
IF RESULT>4
QUIT 1
+10 ; Result field contains a word that starts with "POS" or "pos"
+11 NEW FLG,I
+12 SET FLG=0
+13 IF $EXTRACT(RESULT,1,3)="POS"
SET FLG=1
QUIT FLG
+14 FOR I=1:1:$LENGTH(RESULT)
IF $EXTRACT(RESULT,I)?1P
IF $EXTRACT(RESULT,I+1,I+3)="POS"
SET FLG=1
QUIT
+15 QUIT FLG
+16 ;
PPDNEG(RESULT) ; EP - If the result is negative return a 1 else return a 0.
+1 ; This change is specific to PPD.
+2 ;I $E(RESULT,1)="-" Q 1
+3 ; **NOTE: Documentation does not specify if "<" is considered negative.
+4 SET RESULT=$$UP^XLFSTR(RESULT)
+5 ; Negative (or Non-Reactive)
IF RESULT="N"
QUIT 1
+6 ; Non-Reactive
IF RESULT="NR"
QUIT 1
+7 ; Non-Reactive
IF RESULT="NON-REACTIVE"
QUIT 1
+8 ; Non-Reactive
IF RESULT="NON REACTIVE"
QUIT 1
+9 ; Non-Reactive
IF RESULT="NONREACTIVE"
QUIT 1
+10 ; Negative
IF RESULT="-"
QUIT 1
+11 ; Negative numeric result
IF RESULT?1.N
IF RESULT<5
QUIT 1
+12 ; Result field contains a word that starts with "NEG" or "neg"
+13 NEW FLG,I
+14 SET FLG=0
+15 IF $EXTRACT(RESULT,1,3)="NEG"
SET FLG=1
QUIT FLG
+16 FOR I=1:1:$LENGTH(RESULT)
IF $EXTRACT(RESULT,I)?1P
IF $EXTRACT(RESULT,I+1,I+3)="NEG"
SET FLG=1
QUIT
+17 QUIT FLG
+18 ;
ADDLINE(REM,ARRAY,TEXT,LAST,DUE,LASTTXT) ; EP - Update reminder output array
+1 SET ARRAY(REM)=$GET(ARRAY(REM))+1
+2 SET ARRAY(REM,ARRAY(REM),0)=$GET(TEXT)
+3 SET ARRAY(REM,ARRAY(REM),"LAST")=$GET(LAST)
+4 SET ARRAY(REM,ARRAY(REM),"DUE")=$GET(DUE)
+5 SET ARRAY(REM,ARRAY(REM),"LASTTXT")=$GET(LASTTXT)
+6 QUIT
+7 ;
+8 ; Check for any positive STD tests (other than the one specified in STD) after LDATE.
+9 ; Check for any STD diagnoses (other than the one specified in STD) after LDATE.
+10 ; Valid values for STD are "CHLAMYDIA", "GONORRHEA", "SYPHILIS", "TRICHOMONIASIS" and "OTHER".
+11 ; NOTE: "TRICHOMONIASIS" and "OTHER" are not likely to be used but are maintained for consistency.
STDS(DFN,STD,LDATE) ;EP
+1 NEW PDATE,PRCTEST,PRCDT,PRC,DDATE,LDATE1
+2 ; Use the newer of LDATE or report date minus 365 days.
+3 IF $GET(BDATE)=""
SET BDATE=DT
+4 SET LDATE1=$$FMADD^XLFDT(BDATE,-365)
+5 IF LDATE>LDATE1
SET LDATE1=LDATE
+6 ;Start search on the next day
SET LDATE1=LDATE1\1_".2400"
+7 ; Chlamydia (T.3)
+8 IF STD'="CHLAMYDIA"
DO LABCODES(DFN,"BGP CHLAMYDIA TESTS TAX","BGP CHLAMYDIA LOINC CODES","BTPW CHLAMYDIA CPTS","BGP CHLAMYDIA TEST PROCEDURES",LDATE1,"","","",.PDATE)
IF PDATE'=""
QUIT 1
+9 ; Gonorrhea (T.10)
+10 IF STD'="GONORRHEA"
DO LABCODES(DFN,"BKM GONORRHEA TEST TAX","BKM GONORRHEA LOINC CODES","BKM GONORRHEA TESTS CPTS","",LDATE1,"","","",.PDATE)
IF PDATE'=""
QUIT 1
+11 ; Syphilis (T.22)
+12 IF STD'="SYPHILIS"
DO LABCODES(DFN,"BKM RPR TAX","BKM RPR LOINC CODES","BKM RPR CPTS","",LDATE1,"","","",.PDATE)
IF PDATE'=""
QUIT 1
+13 ; Syphilis (T.9)
+14 IF STD'="SYPHILIS"
DO LABCODES(DFN,"BKM FTA-ABS TEST TAX","BKM FTA-ABS LOINC CODES","BKM FTA-ABS CPTS","",LDATE1,"","","",.PDATE)
IF PDATE'=""
QUIT 1
+15 ;PRXM/HC/BHS - 04/19/2006 - Removed per IHS Issue # 1467
+16 ; Trichomoniasis (T.24)
+17 ;I STD'="TRICHOMONIASIS" D LABCODES(DFN,"BKM TRICH TESTS TAX","BKM TRICH LOINC CODES","","BKM TRICHOMONIASIS DXS",LDATE1,"","","",.PDATE) I PDATE'="" Q 1
+18 ;PRXM/HC/KJH - 04/19/2006 - Removed per IHS Issue # 1460, 1464, 1465 and replaced with other POV diagnosis checks below.
+19 ; Other STD (DX.9)
+20 ;I STD'="OTHER" D LABCODES(DFN,"","","","BKM OTHER STD DXS",LDATE1,"","","",.PDATE) I PDATE'="" Q 1
+21 ; Chlamydia (DX.2)
+22 IF STD'="CHLAMYDIA"
DO ICDTAX^BKMIXX1(DFN,"BKM CHLAMYDIA DXS","",LDATE1,"",.DDATE)
IF DDATE'=""
QUIT 1
+23 ; Gonorrhea (DX.4)
+24 IF STD'="GONORRHEA"
DO ICDTAX^BKMIXX1(DFN,"BKM GONORRHEA DXS","",LDATE1,"",.DDATE)
IF DDATE'=""
QUIT 1
+25 ; Syphilis (DX.11)
+26 IF STD'="SYPHILIS"
DO ICDTAX^BKMIXX1(DFN,"BKM SYPHILIS DXS","",LDATE1,"",.DDATE)
IF DDATE'=""
QUIT 1
+27 ; Trichomoniasis (DX.13)
+28 IF STD'="TRICHOMONIASIS"
DO ICDTAX^BKMIXX1(DFN,"BKM TRICHOMONIASIS DXS","",LDATE1,"",.DDATE)
IF DDATE'=""
QUIT 1
+29 ; Other STD (DX.9)
+30 IF STD'="OTHER"
DO ICDTAX^BKMIXX1(DFN,"BKM OTHER STD DXS","",LDATE1,"",.DDATE)
IF DDATE'=""
QUIT 1
+31 QUIT 0
+32 ;
+33 ; This function cycles through the V-Lab file checking
+34 ; each lab, CPT4, ICD9, and LOINC associated with a DFN to
+35 ; see if each is in an appropriate taxonomy, old enough,
+36 ; and if required positive.
+37 ;
+38 ; DFN is the patient DFN from file 2 or 9000001.
+39 ;
+40 ; LABT is the text name of the lab taxonomy.
+41 ; LOINCT is the text name of the LOINC taxonomy.
+42 ; CPTT is the text name of the CPT taxonomy.
+43 ; ICDT is the text name of the ICD9 taxonomy.
+44 ;
+45 ; BDATE is the base (starting) date for the search.
+46 ;
+47 ; IDATE is the date of the last item (LAB, LOINC, CPT, or ICD) passed by reference.
+48 ;
+49 ; LDATE is the date of the last LAB passed by reference.
+50 ; LR if there is a LDATE then the LR will be equal to the result.
+51 ; LV if there is a LDATE then the LV is the V Lab IEN.
+52 ;
+53 ; PDATE is the date of the last positive LAB passed by reference.
+54 ; PR if there is a PDATE then the PR will be equal to the positive result.
+55 ; PV if there is a PDATE then the PV is the V Lab IEN.
+56 ;
+57 ; NDATE is the date of the last negative LAB passed by reference.
+58 ; NR if there is a NDATE then the NR will be equal to the negative result.
+59 ; NV if there is a NDATE then the NV is the V Lab IEN.
+60 ;
LABCODES(DFN,LABT,LOINCT,CPTT,ICDT,BDATE,IDATE,LDATE,LR,PDATE,PR,NDATE,NR,ODATE,OR,OFLG) ;EP
+1 ; EP - Retrieve lab codes.
+2 NEW QDATE,QV,LV,TARGET,LABTEST,LAB,LABDT,RESULT
+3 SET LABT=$GET(LABT,"")
SET LOINCT=$GET(LOINCT,"")
SET CPTT=$GET(CPTT,"")
SET ICDT=$GET(ICDT,"")
SET OFLG=$GET(OFLG,"")
+4 SET BDATE=$GET(BDATE,"")
SET IDATE=$GET(IDATE,"")
SET LDATE=$GET(LDATE,"")
SET PDATE=$GET(PDATE,"")
SET NDATE=$GET(NDATE,"")
SET ODATE=$GET(ODATE,"")
+5 SET (LV,LR,PR,NR,OR)=""
+6 SET TARGET="LABTEST(VSTDT,TEST)"
+7 SET QDATE=""
SET QV=""
+8 DO LABTAX^BKMIXX(DFN,LABT,"",BDATE,TARGET,.QDATE,.QV)
+9 SET IDATE=QDATE
SET LDATE=QDATE
SET LV=QV
+10 SET QDATE=""
SET QV=""
+11 DO LOINC^BKMIXX(DFN,LOINCT,"",BDATE,TARGET,.QDATE,.QV)
+12 IF QDATE>IDATE
SET IDATE=QDATE
SET LDATE=QDATE
SET LV=QV
+13 SET QDATE=""
SET QV=""
+14 DO CPTTAX^BKMIXX(DFN,CPTT,"",BDATE,TARGET,.QDATE,.QV)
+15 IF QDATE>IDATE
SET IDATE=QDATE
SET LDATE=QDATE
SET LV=QV
+16 SET QDATE=""
SET QV=""
+17 DO ICDTAX^BKMIXX1(DFN,ICDT,"",BDATE,TARGET,.QDATE,.QV)
+18 IF QDATE>IDATE
SET IDATE=QDATE
SET LDATE=QDATE
SET LV=QV
+19 IF LV'=""
SET LR=LABTEST(LDATE,LV)
+20 SET LABDT=""
+21 FOR
SET LABDT=$ORDER(LABTEST(LABDT),-1)
IF LABDT=""
QUIT
Begin DoDot:1
+22 SET LAB=""
+23 FOR
SET LAB=$ORDER(LABTEST(LABDT,LAB),-1)
IF LAB=""
QUIT
Begin DoDot:2
+24 SET RESULT=$PIECE(LABTEST(LABDT,LAB),U)
+25 IF PDATE=""
IF $$POSITIVE^BKMVF32(RESULT)
SET PDATE=LABDT
SET PR=RESULT
+26 IF NDATE=""
IF $$NEGATIVE^BKMVF32(RESULT)
SET NDATE=LABDT
SET NR=RESULT
+27 IF ODATE=""
IF OFLG'=""
IF @OFLG
SET ODATE=LABDT
SET OR=RESULT
+28 QUIT
End DoDot:2
IF PDATE]""
IF NDATE]""
QUIT
+29 QUIT
End DoDot:1
IF PDATE]""
IF NDATE]""
QUIT
+30 QUIT
