BKMVSUP1 ;PRXM/HC/WOM - Continuation of BKMVSUP, HIV SUPPLEMENT; [ 1/19/2005 7:16 PM ] ; 10 Jun 2005 12:31 PM
;;2.2;HIV MANAGEMENT SYSTEM;**2**;Apr 01, 2015;Build 3
Q
CD4(DFN) ; EP - Retrieve CD4 taxonomies
S LINE=" Last 6 CD4: "
; Retrieve CD4 taxonomies
K BKMT("CD4"),BKMT("CD4ABS")
S GLOBAL="BKMT(""CD4"",VSTDT\1,""ALL"",VSTDT,TEST)"
D LABTAX^BKMIXX(DFN,"BGP CD4 TAX","","",GLOBAL)
D LOINC^BKMIXX(DFN,"BGP CD4 LOINC CODES","","",GLOBAL)
S GLOBAL="BKMT(""CD4"",VSTDT\1,""ALL"",VSTDT,TEST)"
D CPTTAX^BKMIXX(DFN,"BGP CD4 CPTS","","",GLOBAL)
; Retrieve CD4 ABS taxonomies
S GLOBAL="BKMT(""CD4"",VSTDT\1,""ABS"",VSTDT,TEST)"
D LABTAX^BKMIXX(DFN,"BKMV CD4 ABS TESTS TAX","","",GLOBAL)
D LOINC^BKMIXX(DFN,"BKMV CD4 ABS LOINC CODES","","",GLOBAL)
S GLOBAL="BKMT(""CD4"",VSTDT\1,""ABS"",VSTDT,TEST)"
D CPTTAX^BKMIXX(DFN,"BKMV CD4 ABS CPTS","","",GLOBAL)
;
; Print 6 most recent results - ABS should be listed in preference to All
; When printing ABS list results - none should be listed for All
; Only one result per day should be printed (consistent with Flow Sheet)
;
N MAX,LDT,CNT,Y,LDTTM,TYPE,RESULT
S MAX=6,(LDT,CNT)=""
F S LDT=$O(BKMT("CD4",LDT),-1) Q:'LDT D Q:CNT=MAX
. S Y=$P($$FMTE^XLFDT(LDT,"5Z"),"@"),CNT=CNT+1
. S LINE=$$LINE^BKMVSUP(LINE,"Date: ",24)_Y
. I $D(BKMT("CD4",LDT,"ABS")) D
.. S LINE=$$LINE^BKMVSUP(LINE,"Result: ",43)
.. S LDTTM="",RESULT=""
.. F S LDTTM=$O(BKMT("CD4",LDT,"ABS",LDTTM),-1) Q:LDTTM="" D Q:RESULT]""
... S TYPE=""
... F S TYPE=$O(BKMT("CD4",LDT,"ABS",LDTTM,TYPE)) Q:TYPE="" D Q:RESULT]""
.... S RESULT=$P(BKMT("CD4",LDT,"ABS",LDTTM,TYPE),U)
.... I RESULT]"" S LINE=LINE_$E(RESULT,1,37) Q
.. ; Only save one result per day for Flow Sheet
.. I TYPE="" S TYPE=$O(BKMT("CD4",LDT,"ABS",""),-1) ; set TYPE if no results found
.. S BKMT("CD4ABS",LDT,TYPE,"ABS")=RESULT
. I '$D(BKMT("CD4",LDT,"ABS")),$D(BKMT("CD4",LDT,"ALL")) D
.. S LDTTM="",RESULT=""
.. F S LDTTM=$O(BKMT("CD4",LDT,"ALL",LDTTM),-1) Q:LDTTM="" D Q:RESULT]""
... S TYPE=""
... F S TYPE=$O(BKMT("CD4",LDT,"ALL",LDTTM,TYPE)) Q:TYPE="" D Q:RESULT]""
.... S RESULT=$P(BKMT("CD4",LDT,"ALL",LDTTM,TYPE),U)
.. ; Only save one result per day for Flow Sheet
.. I TYPE="" S TYPE=$O(BKMT("CD4",LDT,"ALL",""),-1) ; set TYPE if no results found
.. S BKMT("CD4ABS",LDT,TYPE,"ALL")=RESULT
. K BKMT("CD4",LDT)
. I LNCNT>MAXCT D NEWPG^BKMVSUP
. I CNT<MAX,$O(BKMT("CD4",LDT),-1) D UPD^BKMVSUP
K BKMT("CD4")
I LNCNT>MAXCT D NEWPG^BKMVSUP
D UPD^BKMVSUP,BLANK^BKMVSUP(1)
; BKMT("CD4ABS") is later used for the Flow Sheet
Q
VIRAL(DFN) ; EP - Retrieve Viral taxonomies
I LNCNT>MAXCT D NEWPG^BKMVSUP
S LINE=" Last 6 HIV/RNA Viral Load: " D UPD^BKMVSUP
; Retrieve Viral Load taxonomies
K BKMT("VL")
S GLOBAL="BKMT(""VL"",VSTDT,TEST,""LAB"")"
D LABTAX^BKMIXX(DFN,"BGP HIV VIRAL LOAD TAX","","",GLOBAL)
D LOINC^BKMIXX(DFN,"BGP VIRAL LOAD LOINC CODES","","",GLOBAL)
S GLOBAL="BKMT(""VL"",VSTDT,TEST,""CPT"")"
D CPTTAX^BKMIXX(DFN,"BGP HIV VIRAL LOAD CPTS","","",GLOBAL)
D LTAXPRT("VL",6,1,"","","",1)
D UPD^BKMVSUP
; BKMT("VL") is later used for the Flow Sheet
Q
;
RPR(DFN) ; EP - Retrieve RPR taxonomies
S LINE=" RPR: "
K BKMT("RPR")
S GLOBAL="BKMT(""RPR"",VSTDT,TEST,""LAB"")"
D LABTAX^BKMIXX(DFN,"BKM RPR TAX","","",GLOBAL) ;***
D LOINC^BKMIXX(DFN,"BKM RPR LOINC CODES","","",GLOBAL)
S GLOBAL="BKMT(""RPR"",VSTDT,TEST,""CPT"")"
D CPTTAX^BKMIXX(DFN,"BKM RPR CPTS","","",GLOBAL)
; Print results
D LTAXPRT("RPR",1,1,,,,1)
; If no results found check refusal file
I '$D(BKMT("RPR")) D
. S GLOBAL="BKMT(""RPR"",VSTDT,TEST,""LAB"")"
. D REFUSAL^BKMIXX2(DFN,60,"BKM RPR TAX","","",GLOBAL) ;taxonomy not loaded yet
. D REFUSAL^BKMIXX2(DFN,60,"BKM RPR LOINC CODES","","",GLOBAL)
. ; Print results
. D LTAXPRT("RPR",1,1,1,,,1)
K BKMT("RPR")
I LINE'="" D UPD^BKMVSUP
Q
PAP(DFN) ; EP - Retrieve PAP taxonomies
; Q:$P(^DPT(DFN,0),U,2)'="F" ; - removed and replaced with N/A as per IHS
S LINE=" PAP: "
I $P(^DPT(DFN,0),U,2)'="F" S LINE=LINE_"Not Applicable" Q ;Females only
K BKMT("PAP")
S GLOBAL="BKMT(""PAP"",VSTDT,""LAB"",TEST)"
D LABTAX^BKMIXX(DFN,"BGP PAP SMEAR TAX","","",GLOBAL)
D LOINC^BKMIXX(DFN,"BGP PAP LOINC CODES","","",GLOBAL)
S GLOBAL="BKMT(""PAP"",VSTDT,""CPT"",TEST)"
D CPTTAX^BKMIXX(DFN,"BGP CPT PAP","","",GLOBAL)
S GLOBAL="BKMT(""PAP"",VSTDT,""ICD"",TEST)"
D ICDTAX^BKMIXX1(DFN,"BGP PAP SMEAR DXS","","",GLOBAL)
S GLOBAL="BKMT(""PAP"",VSTDT,""PROC"",TEST)"
D PRCTAX^BKMIXX1(DFN,"BQI PAP PROCEDURES","","",GLOBAL)
;
N LDT,CNT,Y,TST
S (LDT,CNT)=""
F S LDT=$O(BKMT("PAP",LDT),-1) Q:'LDT D Q:CNT
. I $O(BKMT("PAP",LDT,""))="" Q
. S CNT=1,Y=$P($$FMTE^XLFDT(LDT,"5Z"),"@")
. S LINE=$$LINE^BKMVSUP(LINE,"Date: ",24)_Y,LINE=$$LINE^BKMVSUP(LINE,"Result: ",41)
. ;Only print lab results
. I $D(BKMT("PAP",LDT,"LAB")) D
.. S TST=$O(BKMT("PAP",LDT,"LAB",""),-1)
.. S LINE=LINE_$E($P(BKMT("PAP",LDT,"LAB",TST),U),1,37) Q
; If no results found check refusal file
I '$D(BKMT("PAP")) D
. S GLOBAL="BKMT(""PAP"",VSTDT,TEST,""LAB"")"
. D REFUSAL^BKMIXX2(DFN,60,"BGP PAP SMEAR TAX","","",GLOBAL)
. D REFUSAL^BKMIXX2(DFN,60,"BGP PAP LOINC CODES","","",GLOBAL)
. ;Print results
. D LTAXPRT("PAP",1,1,1)
K BKMT("PAP")
I LINE'="" D UPD^BKMVSUP
Q
CHL(DFN) ; EP - Retrieve Chlamydia taxonomies
S LINE=" Chlamydia: "
K BKMT("CHL")
S GLOBAL="BKMT(""CHL"",VSTDT,TEST,""LAB"")"
D LABTAX^BKMIXX(DFN,"BGP CHLAMYDIA TESTS TAX","","",GLOBAL)
D LOINC^BKMIXX(DFN,"BGP CHLAMYDIA LOINC CODES","","",GLOBAL)
S GLOBAL="BKMT(""CHL"",VSTDT,TEST,""ICD"")"
;D PRCTAX^BKMIXX1(DFN,"BGP CHLAMYDIA TEST PROCEDURES","","",GLOBAL)
D ICDTAX^BKMIXX1(DFN,"BQI CHLAMYDIA SCREEN DXS","","",GLOBAL)
S GLOBAL="BKMT(""CHL"",VSTDT,TEST,""CPT"")"
D CPTTAX^BKMIXX(DFN,"BTPW CHLAMYDIA CPTS","","",GLOBAL)
; Print results
D LTAXPRT("CHL",1,1,,,,1)
; If no results found check refusal file
I '$D(BKMT("CHL")) D
. S GLOBAL="BKMT(""CHL"",VSTDT,TEST,""LAB"")"
. D REFUSAL^BKMIXX2(DFN,60,"BGP CHLAMYDIA TESTS TAX","","",GLOBAL)
. D REFUSAL^BKMIXX2(DFN,60,"BGP CHLAMYDIA LOINC CODES","","",GLOBAL)
. ; Print results
. D LTAXPRT("CHL",1,1,1)
K BKMT("CHL")
I LINE'="" D UPD^BKMVSUP
Q
GON(DFN) ; EP - Retrieve Gonorrhea taxonomies
S LINE=" Gonorrhea: "
K BKMT("GON")
S GLOBAL="BKMT(""GON"",VSTDT,TEST,""LAB"")"
D LABTAX^BKMIXX(DFN,"BKM GONORRHEA TEST TAX","","",GLOBAL) ;***
D LOINC^BKMIXX(DFN,"BKM GONORRHEA LOINC CODES","","",GLOBAL)
S GLOBAL="BKMT(""GON"",VSTDT,TEST,""CPT"")"
D CPTTAX^BKMIXX(DFN,"BKM GONORRHEA TESTS CPTS","","",GLOBAL)
; Print results
D LTAXPRT("GON",1,1,,,,1)
; If no results found check refusal file
I '$D(BKMT("GON")) D
. S GLOBAL="BKMT(""GON"",VSTDT,TEST,""LAB"")"
. D REFUSAL^BKMIXX2(DFN,60,"BKM GONORRHEA LOINC CODES","","",GLOBAL)
. D REFUSAL^BKMIXX2(DFN,60,"BKM GONORRHEA TEST TAX","","",GLOBAL)
. ; Print results
. D LTAXPRT("GON",1,1,1)
K BKMT("GON")
I LINE'="" D UPD^BKMVSUP
Q
CMV(DFN) ; EP - Retrieve CMV taxonomies
S LINE=" CMV: "
K BKMT("CMV")
S GLOBAL="BKMT(""CMV"",VSTDT,TEST,""LAB"")"
D LABTAX^BKMIXX(DFN,"BKM CMV TEST TAX","","",GLOBAL) ;***
D LOINC^BKMIXX(DFN,"BKM CMV LOINC CODES","","",GLOBAL)
S GLOBAL="BKMT(""CMV"",VSTDT,TEST,""CPT"")"
D CPTTAX^BKMIXX(DFN,"BKM CMV TEST CPTS","","",GLOBAL)
; Print results
D LTAXPRT("CMV",1,1,,,,1)
; If no results found check refusal file
I '$D(BKMT("CMV")) D
. S GLOBAL="BKMT(""CMV"",VSTDT,TEST,""LAB"")"
. D REFUSAL^BKMIXX2(DFN,60,"BKM CMV LOINC CODES","","",GLOBAL)
. D REFUSAL^BKMIXX2(DFN,60,"BKM CMV TEST TAX","","",GLOBAL)
. ; Print results
. D LTAXPRT("CMV",1,1,1)
K BKMT("CMV")
I LINE'="" D UPD^BKMVSUP
Q
TOX(DFN) ; EP - Retrieve Toxoplasmosis taxonomies
S LINE=" Toxoplasmosis: "
K BKMT("TOX")
S GLOBAL="BKMT(""TOX"",VSTDT,TEST,""LAB"")"
D LABTAX^BKMIXX(DFN,"BKM TOXOPLASMOSIS TESTS TAX","","",GLOBAL) ;***
D LOINC^BKMIXX(DFN,"BKM TOXOPLASMOSIS LOINC CODES","","",GLOBAL)
S GLOBAL="BKMT(""TOX"",VSTDT,TEST,""CPT"")"
D CPTTAX^BKMIXX(DFN,"BKM TOXOPLASMOSIS CPTS","","",GLOBAL)
; Print results
D LTAXPRT("TOX",1,1,,,,1)
; If no results found check refusal file
I '$D(BKMT("TOX")) D
. S GLOBAL="BKMT(""TOX"",VSTDT,TEST,""LAB"")"
. D REFUSAL^BKMIXX2(DFN,60,"BKM TOXOPLASMOSIS LOINC CODES","","",GLOBAL)
. D REFUSAL^BKMIXX2(DFN,60,"BKM TOXOPLASMOSIS TESTS TAX","","",GLOBAL)
. ; Print results
. D LTAXPRT("TOX",1,1,1)
K BKMT("TOX")
I LINE'="" D UPD^BKMVSUP
Q
COC(DFN) ; EP - Retrieve Cocci taxonomies
S LINE=" Cocci: "
K BKMT("COC")
S GLOBAL="BKMT(""COC"",VSTDT,TEST,""LAB"")"
D LABTAX^BKMIXX(DFN,"BKM COCCI ANTIBODY TAX","","",GLOBAL) ;***
D LOINC^BKMIXX(DFN,"BKM COCCI ANTIBODY LOINC CODES","","",GLOBAL)
S GLOBAL="BKMT(""COC"",VSTDT,TEST,""CPT"")"
D CPTTAX^BKMIXX(DFN,"BKM COCCI ANTIBODY CPTS","","",GLOBAL)
; Print results
I $D(BKMT("COC")) D LTAXPRT("COC",1,1,,,,1) Q
; Check refusals
S GLOBAL="BKMT(""COC"",VSTDT,TEST,""LAB"")"
D REFUSAL^BKMIXX2(DFN,60,"BKM COCCI ANTIBODY LOINC CODES","","",GLOBAL)
D REFUSAL^BKMIXX2(DFN,60,"BKM COCCI ANTIBODY TAX","","",GLOBAL)
; Print results
D LTAXPRT("COC",1,1,1)
K BKMT("COC")
I LINE'="" D UPD^BKMVSUP
Q
PPD(DFN) ; EP - Retrieve PPD taxonomies (T.21)
S LINE=" PPD: "
K BKMT("PPD")
S GLOBAL="BKMT(""PPD"",VSTDT,TEST,""LAB"")"
D LABTAX^BKMIXX(DFN,"BKM PPD TAX","","",GLOBAL) ;***
D LOINC^BKMIXX(DFN,"BKM PPD LOINC CODES","","",GLOBAL)
S GLOBAL="BKMT(""PPD"",VSTDT,TEST,""CPT"")"
D CPTTAX^BKMIXX(DFN,"BKM PPD CPTS","","",GLOBAL)
S GLOBAL="BKMT(""PPD"",VSTDT,TEST,""CVX"")"
D CVXTAX^BKMIXX1(DFN,"BKM PPD CVX CODES","","",GLOBAL)
I $D(BKMT("PPD")) D LTAXPRT("PPD",1,1,,,,1)
I '$D(BKMT("PPD")) D
. ; If patient had no PPD T.21 in Labs, also check Skin Tests.
. S GLOBAL="BKMT(""PPD"",VSTDT,TEST,""SKIN"")"
. D SKNTAX^BKMIXX1(DFN,"21","","",GLOBAL)
. ; Following code was modified to display Result and Reading in that order
. I $D(BKMT("PPD")) D Q
.. N BKMTL
.. S BKMTL="BKMT(""PPD"")"
.. F S BKMTL=$Q(@BKMTL) Q:$P(BKMTL,",")'="BKMT(""PPD""" D
... I $P(@BKMTL,U,2)]"" S @BKMTL=$P(@BKMTL,U,2)_" "_$P(@BKMTL,U)
.. D LTAXPRT("PPD",1,1)
. ; If nothing found check diagnosis taxonomy BKM PPD ICDS and include the text "(by Diagnosis)"
. S GLOBAL="BKMT(""PPD"",VSTDT,TEST,""ICD"")"
. D ICDTAX^BKMIXX1(DFN,"BKM PPD ICDS","","",GLOBAL)
. I $D(BKMT("PPD")) D LTAXPRT("PPD",1,1,"",""," (by Diagnosis)") Q
. ; Check refusals
. S GLOBAL="BKMT(""PPD"",VSTDT,TEST,""LAB"")"
. D REFUSAL^BKMIXX2(DFN,60,"BKM PPD LOINC CODES","","",GLOBAL)
. D REFUSAL^BKMIXX2(DFN,60,"BKM PPD TAX","","",GLOBAL)
. D REFUSAL^BKMIXX2(DFN,9999999.14,"BKM PPD CVX CODES","","",GLOBAL)
. D REFUSAL^BKMIXX2(DFN,9999999.28,"21","","",GLOBAL)
. ; Print results
. D LTAXPRT("PPD",1,1,1)
K BKMT("PPD")
I LINE'="" D UPD^BKMVSUP
Q
PHENO(DFN) ; EP - Retrieve HIV Phenotype Taxonomies (T.16)
S LINE=" HIV Phenotype: "
K BKMT("PHENO")
S GLOBAL="BKMT(""PHENO"",VSTDT,TEST,""LAB"")"
D LABTAX^BKMIXX(DFN,"BKMV HIV PHENOTYPE TESTS TAX","","",GLOBAL)
S GLOBAL="BKMT(""PHENO"",VSTDT,TEST,""CPT"")"
D CPTTAX^BKMIXX(DFN,"BKMV HIV PHENOTYPE CPTS","","",GLOBAL)
; Print results
I $D(BKMT("PHENO")) D LTAXPRT("PHENO",5) I LINE'="" D UPD^BKMVSUP Q
;I $D(BKMT("PHENO")) D LTAXPRT("PHENO",1,1) Q
K BKMT("PHENO")
I LINE'="" D UPD^BKMVSUP
Q
GENO(DFN) ; EP - Retrieve HIV Genotype Taxonomies
S LINE=" HIV Genotype: "
K BKMT("GENO")
S GLOBAL="BKMT(""GENO"",VSTDT,TEST,""LAB"")"
D LABTAX^BKMIXX(DFN,"BKMV HIV GENOTYPE TESTS TAX","","",GLOBAL)
S GLOBAL="BKMT(""GENO"",VSTDT,TEST,""CPT"")"
D CPTTAX^BKMIXX(DFN,"BKMV HIV GENOTYPE CPTS","","",GLOBAL)
; Print results
I $D(BKMT("GENO")) D LTAXPRT("GENO",5) I LINE'="" D UPD^BKMVSUP Q
;I $D(BKMT("GENO")) D LTAXPRT("GENO",1,1) Q
K BKMT("GENO")
I LINE'="" D UPD^BKMVSUP
Q
LTAXPRT(TYP,MAX,RES,REF,TBEF,TAFT,ONE,DTP) ; EP - Print lab related taxonomies for a patient
;
; TYP = Type of test (subscript in BKMT array)
; MAX = Maximum number of results to print
; $G(RES)=1 - Print results
; TBEF = text before
; REF = Refusal flag
; TAFT = text after
; ONE = Only display one result per day
; DTP = Date text - replaces standard "Date: " display
;
N LDT,CNT,Y,TST,TYPE,END
S MAX=$G(MAX,1),REF=$G(REF),ONE=$G(ONE),RES=$G(RES),DTP=$G(DTP)
S (LDT,CNT)=""
F S LDT=$O(BKMT(TYP,LDT),-1) Q:'LDT D Q:CNT>MAX
. S Y=$P($$FMTE^XLFDT(LDT,"5Z"),"@")
. I RES,'ONE,'REF D GETRES(TYP,LDT)
. I ONE D ONERES(TYP,LDT)
. S TST=""
. F S TST=$O(BKMT(TYP,LDT,TST)) Q:TST="" D Q:CNT>MAX
.. S TYPE=""
.. F S TYPE=$O(BKMT(TYP,LDT,TST,TYPE)) Q:TYPE="" S CNT=CNT+1 Q:CNT>MAX D
... S LINE=$$LINE^BKMVSUP(LINE,$S(DTP]"":DTP,1:"Date: "),24)_Y
... I RES D
.... S LINE=$$LINE^BKMVSUP(LINE,"",41)
.... I $G(TBEF)]"" S LINE=LINE_TBEF
.... I REF S LINE=LINE_"[Refusal type: "_$E($P(BKMT(TYP,LDT,TST,TYPE),U),1,37)_"]"
.... E S LINE=LINE_"Result: "_$E($P(BKMT(TYP,LDT,TST,TYPE),U),1,37)
.... I $G(TAFT)]"" S LINE=LINE_TAFT
.... I CNT<MAX D UPD^BKMVSUP
.... I LNCNT>MAXCT D NEWPG^BKMVSUP
... I 'RES,CNT<MAX D
.... I $O(BKMT(TYP,LDT),-1)!($O(BKMT(TYP,LDT,TST,TYPE))]"")!($O(BKMT(TYP,LDT,TST))]"") D UPD^BKMVSUP
Q:CNT
I LNCNT>MAXCT D NEWPG^BKMVSUP
Q
;
ONERES(TYP,LDT) ; Display only one result per day
; Pare down array to the one entry to be displayed
N STOP,TST,TYPE,RES,LDTTM
O1 S (STOP,TST)=""
F S TST=$O(BKMT(TYP,LDT,TST)) Q:TST="" D Q:STOP
. S TYPE=""
. F S TYPE=$O(BKMT(TYP,LDT,TST,TYPE)) Q:TYPE="" D Q:STOP
.. S RES=BKMT(TYP,LDT,TST,TYPE)
.. I $P(RES,U)'="" D S STOP=1 Q
... K BKMT(TYP,LDT) S BKMT(TYP,LDT,TST,TYPE)=RES
... ; Remove other entries for this date
... S LDTTM=LDT
... F S LDTTM=$O(BKMT(TYP,LDTTM),-1) Q:LDTTM\1'=(LDT\1) K BKMT(TYP,LDTTM)
Q:STOP
; Check remaining entries on this date for results
S LDTTM=$O(BKMT(TYP,LDT),-1)
I LDTTM\1=(LDT\1) K BKMT(TYP,LDT) S LDT=LDTTM G O1
; No results found - save one entry
S TST=$O(BKMT(TYP,LDT,"")) Q:TST=""
S TYPE=$O(BKMT(TYP,LDT,TST,"")) Q:TYPE=""
S RES=$G(BKMT(TYP,LDT,TST,TYPE))
K BKMT(TYP,LDT) S BKMT(TYP,LDT,TST,TYPE)=RES
Q
;
GETRES(TYP,LDT) ; If more than one entry/day get entry with result
N TEST,LPEND
S LPEND="BKMT("""_TYP_""","_LDT,TEST=LPEND_")"
; Loop through entries for the date and remove any tests w/o results until you either
; find a test with a result or get to the last test for the date
F S TEST=$Q(@TEST) Q:$P(TEST,",",1,2)'=LPEND Q:@TEST]"" D
. ; If this isn't the last test for the date and there is no result remove it
. I $P($Q(@TEST),",",1,2)=LPEND K @TEST
Q
;
XIT ; QUIT POINT
Q
BKMVSUP1 ;PRXM/HC/WOM - Continuation of BKMVSUP, HIV SUPPLEMENT; [ 1/19/2005 7:16 PM ] ; 10 Jun 2005 12:31 PM
+1 ;;2.2;HIV MANAGEMENT SYSTEM;**2**;Apr 01, 2015;Build 3
+2 QUIT
CD4(DFN) ; EP - Retrieve CD4 taxonomies
+1 SET LINE=" Last 6 CD4: "
+2 ; Retrieve CD4 taxonomies
+3 KILL BKMT("CD4"),BKMT("CD4ABS")
+4 SET GLOBAL="BKMT(""CD4"",VSTDT\1,""ALL"",VSTDT,TEST)"
+5 DO LABTAX^BKMIXX(DFN,"BGP CD4 TAX","","",GLOBAL)
+6 DO LOINC^BKMIXX(DFN,"BGP CD4 LOINC CODES","","",GLOBAL)
+7 SET GLOBAL="BKMT(""CD4"",VSTDT\1,""ALL"",VSTDT,TEST)"
+8 DO CPTTAX^BKMIXX(DFN,"BGP CD4 CPTS","","",GLOBAL)
+9 ; Retrieve CD4 ABS taxonomies
+10 SET GLOBAL="BKMT(""CD4"",VSTDT\1,""ABS"",VSTDT,TEST)"
+11 DO LABTAX^BKMIXX(DFN,"BKMV CD4 ABS TESTS TAX","","",GLOBAL)
+12 DO LOINC^BKMIXX(DFN,"BKMV CD4 ABS LOINC CODES","","",GLOBAL)
+13 SET GLOBAL="BKMT(""CD4"",VSTDT\1,""ABS"",VSTDT,TEST)"
+14 DO CPTTAX^BKMIXX(DFN,"BKMV CD4 ABS CPTS","","",GLOBAL)
+15 ;
+16 ; Print 6 most recent results - ABS should be listed in preference to All
+17 ; When printing ABS list results - none should be listed for All
+18 ; Only one result per day should be printed (consistent with Flow Sheet)
+19 ;
+20 NEW MAX,LDT,CNT,Y,LDTTM,TYPE,RESULT
+21 SET MAX=6
SET (LDT,CNT)=""
+22 FOR
SET LDT=$ORDER(BKMT("CD4",LDT),-1)
IF 'LDT
QUIT
Begin DoDot:1
+23 SET Y=$PIECE($$FMTE^XLFDT(LDT,"5Z"),"@")
SET CNT=CNT+1
+24 SET LINE=$$LINE^BKMVSUP(LINE,"Date: ",24)_Y
+25 IF $DATA(BKMT("CD4",LDT,"ABS"))
Begin DoDot:2
+26 SET LINE=$$LINE^BKMVSUP(LINE,"Result: ",43)
+27 SET LDTTM=""
SET RESULT=""
+28 FOR
SET LDTTM=$ORDER(BKMT("CD4",LDT,"ABS",LDTTM),-1)
IF LDTTM=""
QUIT
Begin DoDot:3
+29 SET TYPE=""
+30 FOR
SET TYPE=$ORDER(BKMT("CD4",LDT,"ABS",LDTTM,TYPE))
IF TYPE=""
QUIT
Begin DoDot:4
+31 SET RESULT=$PIECE(BKMT("CD4",LDT,"ABS",LDTTM,TYPE),U)
+32 IF RESULT]""
SET LINE=LINE_$EXTRACT(RESULT,1,37)
QUIT
End DoDot:4
IF RESULT]""
QUIT
End DoDot:3
IF RESULT]""
QUIT
+33 ; Only save one result per day for Flow Sheet
+34 ; set TYPE if no results found
IF TYPE=""
SET TYPE=$ORDER(BKMT("CD4",LDT,"ABS",""),-1)
+35 SET BKMT("CD4ABS",LDT,TYPE,"ABS")=RESULT
End DoDot:2
+36 IF '$DATA(BKMT("CD4",LDT,"ABS"))
IF $DATA(BKMT("CD4",LDT,"ALL"))
Begin DoDot:2
+37 SET LDTTM=""
SET RESULT=""
+38 FOR
SET LDTTM=$ORDER(BKMT("CD4",LDT,"ALL",LDTTM),-1)
IF LDTTM=""
QUIT
Begin DoDot:3
+39 SET TYPE=""
+40 FOR
SET TYPE=$ORDER(BKMT("CD4",LDT,"ALL",LDTTM,TYPE))
IF TYPE=""
QUIT
Begin DoDot:4
+41 SET RESULT=$PIECE(BKMT("CD4",LDT,"ALL",LDTTM,TYPE),U)
End DoDot:4
IF RESULT]""
QUIT
End DoDot:3
IF RESULT]""
QUIT
+42 ; Only save one result per day for Flow Sheet
+43 ; set TYPE if no results found
IF TYPE=""
SET TYPE=$ORDER(BKMT("CD4",LDT,"ALL",""),-1)
+44 SET BKMT("CD4ABS",LDT,TYPE,"ALL")=RESULT
End DoDot:2
+45 KILL BKMT("CD4",LDT)
+46 IF LNCNT>MAXCT
DO NEWPG^BKMVSUP
+47 IF CNT<MAX
IF $ORDER(BKMT("CD4",LDT),-1)
DO UPD^BKMVSUP
End DoDot:1
IF CNT=MAX
QUIT
+48 KILL BKMT("CD4")
+49 IF LNCNT>MAXCT
DO NEWPG^BKMVSUP
+50 DO UPD^BKMVSUP
DO BLANK^BKMVSUP(1)
+51 ; BKMT("CD4ABS") is later used for the Flow Sheet
+52 QUIT
VIRAL(DFN) ; EP - Retrieve Viral taxonomies
+1 IF LNCNT>MAXCT
DO NEWPG^BKMVSUP
+2 SET LINE=" Last 6 HIV/RNA Viral Load: "
DO UPD^BKMVSUP
+3 ; Retrieve Viral Load taxonomies
+4 KILL BKMT("VL")
+5 SET GLOBAL="BKMT(""VL"",VSTDT,TEST,""LAB"")"
+6 DO LABTAX^BKMIXX(DFN,"BGP HIV VIRAL LOAD TAX","","",GLOBAL)
+7 DO LOINC^BKMIXX(DFN,"BGP VIRAL LOAD LOINC CODES","","",GLOBAL)
+8 SET GLOBAL="BKMT(""VL"",VSTDT,TEST,""CPT"")"
+9 DO CPTTAX^BKMIXX(DFN,"BGP HIV VIRAL LOAD CPTS","","",GLOBAL)
+10 DO LTAXPRT("VL",6,1,"","","",1)
+11 DO UPD^BKMVSUP
+12 ; BKMT("VL") is later used for the Flow Sheet
+13 QUIT
+14 ;
RPR(DFN) ; EP - Retrieve RPR taxonomies
+1 SET LINE=" RPR: "
+2 KILL BKMT("RPR")
+3 SET GLOBAL="BKMT(""RPR"",VSTDT,TEST,""LAB"")"
+4 ;***
DO LABTAX^BKMIXX(DFN,"BKM RPR TAX","","",GLOBAL)
+5 DO LOINC^BKMIXX(DFN,"BKM RPR LOINC CODES","","",GLOBAL)
+6 SET GLOBAL="BKMT(""RPR"",VSTDT,TEST,""CPT"")"
+7 DO CPTTAX^BKMIXX(DFN,"BKM RPR CPTS","","",GLOBAL)
+8 ; Print results
+9 DO LTAXPRT("RPR",1,1,,,,1)
+10 ; If no results found check refusal file
+11 IF '$DATA(BKMT("RPR"))
Begin DoDot:1
+12 SET GLOBAL="BKMT(""RPR"",VSTDT,TEST,""LAB"")"
+13 ;taxonomy not loaded yet
DO REFUSAL^BKMIXX2(DFN,60,"BKM RPR TAX","","",GLOBAL)
+14 DO REFUSAL^BKMIXX2(DFN,60,"BKM RPR LOINC CODES","","",GLOBAL)
+15 ; Print results
+16 DO LTAXPRT("RPR",1,1,1,,,1)
End DoDot:1
+17 KILL BKMT("RPR")
+18 IF LINE'=""
DO UPD^BKMVSUP
+19 QUIT
PAP(DFN) ; EP - Retrieve PAP taxonomies
+1 ; Q:$P(^DPT(DFN,0),U,2)'="F" ; - removed and replaced with N/A as per IHS
+2 SET LINE=" PAP: "
+3 ;Females only
IF $PIECE(^DPT(DFN,0),U,2)'="F"
SET LINE=LINE_"Not Applicable"
QUIT
+4 KILL BKMT("PAP")
+5 SET GLOBAL="BKMT(""PAP"",VSTDT,""LAB"",TEST)"
+6 DO LABTAX^BKMIXX(DFN,"BGP PAP SMEAR TAX","","",GLOBAL)
+7 DO LOINC^BKMIXX(DFN,"BGP PAP LOINC CODES","","",GLOBAL)
+8 SET GLOBAL="BKMT(""PAP"",VSTDT,""CPT"",TEST)"
+9 DO CPTTAX^BKMIXX(DFN,"BGP CPT PAP","","",GLOBAL)
+10 SET GLOBAL="BKMT(""PAP"",VSTDT,""ICD"",TEST)"
+11 DO ICDTAX^BKMIXX1(DFN,"BGP PAP SMEAR DXS","","",GLOBAL)
+12 SET GLOBAL="BKMT(""PAP"",VSTDT,""PROC"",TEST)"
+13 DO PRCTAX^BKMIXX1(DFN,"BQI PAP PROCEDURES","","",GLOBAL)
+14 ;
+15 NEW LDT,CNT,Y,TST
+16 SET (LDT,CNT)=""
+17 FOR
SET LDT=$ORDER(BKMT("PAP",LDT),-1)
IF 'LDT
QUIT
Begin DoDot:1
+18 IF $ORDER(BKMT("PAP",LDT,""))=""
QUIT
+19 SET CNT=1
SET Y=$PIECE($$FMTE^XLFDT(LDT,"5Z"),"@")
+20 SET LINE=$$LINE^BKMVSUP(LINE,"Date: ",24)_Y
SET LINE=$$LINE^BKMVSUP(LINE,"Result: ",41)
+21 ;Only print lab results
+22 IF $DATA(BKMT("PAP",LDT,"LAB"))
Begin DoDot:2
+23 SET TST=$ORDER(BKMT("PAP",LDT,"LAB",""),-1)
+24 SET LINE=LINE_$EXTRACT($PIECE(BKMT("PAP",LDT,"LAB",TST),U),1,37)
QUIT
End DoDot:2
End DoDot:1
IF CNT
QUIT
+25 ; If no results found check refusal file
+26 IF '$DATA(BKMT("PAP"))
Begin DoDot:1
+27 SET GLOBAL="BKMT(""PAP"",VSTDT,TEST,""LAB"")"
+28 DO REFUSAL^BKMIXX2(DFN,60,"BGP PAP SMEAR TAX","","",GLOBAL)
+29 DO REFUSAL^BKMIXX2(DFN,60,"BGP PAP LOINC CODES","","",GLOBAL)
+30 ;Print results
+31 DO LTAXPRT("PAP",1,1,1)
End DoDot:1
+32 KILL BKMT("PAP")
+33 IF LINE'=""
DO UPD^BKMVSUP
+34 QUIT
CHL(DFN) ; EP - Retrieve Chlamydia taxonomies
+1 SET LINE=" Chlamydia: "
+2 KILL BKMT("CHL")
+3 SET GLOBAL="BKMT(""CHL"",VSTDT,TEST,""LAB"")"
+4 DO LABTAX^BKMIXX(DFN,"BGP CHLAMYDIA TESTS TAX","","",GLOBAL)
+5 DO LOINC^BKMIXX(DFN,"BGP CHLAMYDIA LOINC CODES","","",GLOBAL)
+6 SET GLOBAL="BKMT(""CHL"",VSTDT,TEST,""ICD"")"
+7 ;D PRCTAX^BKMIXX1(DFN,"BGP CHLAMYDIA TEST PROCEDURES","","",GLOBAL)
+8 DO ICDTAX^BKMIXX1(DFN,"BQI CHLAMYDIA SCREEN DXS","","",GLOBAL)
+9 SET GLOBAL="BKMT(""CHL"",VSTDT,TEST,""CPT"")"
+10 DO CPTTAX^BKMIXX(DFN,"BTPW CHLAMYDIA CPTS","","",GLOBAL)
+11 ; Print results
+12 DO LTAXPRT("CHL",1,1,,,,1)
+13 ; If no results found check refusal file
+14 IF '$DATA(BKMT("CHL"))
Begin DoDot:1
+15 SET GLOBAL="BKMT(""CHL"",VSTDT,TEST,""LAB"")"
+16 DO REFUSAL^BKMIXX2(DFN,60,"BGP CHLAMYDIA TESTS TAX","","",GLOBAL)
+17 DO REFUSAL^BKMIXX2(DFN,60,"BGP CHLAMYDIA LOINC CODES","","",GLOBAL)
+18 ; Print results
+19 DO LTAXPRT("CHL",1,1,1)
End DoDot:1
+20 KILL BKMT("CHL")
+21 IF LINE'=""
DO UPD^BKMVSUP
+22 QUIT
GON(DFN) ; EP - Retrieve Gonorrhea taxonomies
+1 SET LINE=" Gonorrhea: "
+2 KILL BKMT("GON")
+3 SET GLOBAL="BKMT(""GON"",VSTDT,TEST,""LAB"")"
+4 ;***
DO LABTAX^BKMIXX(DFN,"BKM GONORRHEA TEST TAX","","",GLOBAL)
+5 DO LOINC^BKMIXX(DFN,"BKM GONORRHEA LOINC CODES","","",GLOBAL)
+6 SET GLOBAL="BKMT(""GON"",VSTDT,TEST,""CPT"")"
+7 DO CPTTAX^BKMIXX(DFN,"BKM GONORRHEA TESTS CPTS","","",GLOBAL)
+8 ; Print results
+9 DO LTAXPRT("GON",1,1,,,,1)
+10 ; If no results found check refusal file
+11 IF '$DATA(BKMT("GON"))
Begin DoDot:1
+12 SET GLOBAL="BKMT(""GON"",VSTDT,TEST,""LAB"")"
+13 DO REFUSAL^BKMIXX2(DFN,60,"BKM GONORRHEA LOINC CODES","","",GLOBAL)
+14 DO REFUSAL^BKMIXX2(DFN,60,"BKM GONORRHEA TEST TAX","","",GLOBAL)
+15 ; Print results
+16 DO LTAXPRT("GON",1,1,1)
End DoDot:1
+17 KILL BKMT("GON")
+18 IF LINE'=""
DO UPD^BKMVSUP
+19 QUIT
CMV(DFN) ; EP - Retrieve CMV taxonomies
+1 SET LINE=" CMV: "
+2 KILL BKMT("CMV")
+3 SET GLOBAL="BKMT(""CMV"",VSTDT,TEST,""LAB"")"
+4 ;***
DO LABTAX^BKMIXX(DFN,"BKM CMV TEST TAX","","",GLOBAL)
+5 DO LOINC^BKMIXX(DFN,"BKM CMV LOINC CODES","","",GLOBAL)
+6 SET GLOBAL="BKMT(""CMV"",VSTDT,TEST,""CPT"")"
+7 DO CPTTAX^BKMIXX(DFN,"BKM CMV TEST CPTS","","",GLOBAL)
+8 ; Print results
+9 DO LTAXPRT("CMV",1,1,,,,1)
+10 ; If no results found check refusal file
+11 IF '$DATA(BKMT("CMV"))
Begin DoDot:1
+12 SET GLOBAL="BKMT(""CMV"",VSTDT,TEST,""LAB"")"
+13 DO REFUSAL^BKMIXX2(DFN,60,"BKM CMV LOINC CODES","","",GLOBAL)
+14 DO REFUSAL^BKMIXX2(DFN,60,"BKM CMV TEST TAX","","",GLOBAL)
+15 ; Print results
+16 DO LTAXPRT("CMV",1,1,1)
End DoDot:1
+17 KILL BKMT("CMV")
+18 IF LINE'=""
DO UPD^BKMVSUP
+19 QUIT
TOX(DFN) ; EP - Retrieve Toxoplasmosis taxonomies
+1 SET LINE=" Toxoplasmosis: "
+2 KILL BKMT("TOX")
+3 SET GLOBAL="BKMT(""TOX"",VSTDT,TEST,""LAB"")"
+4 ;***
DO LABTAX^BKMIXX(DFN,"BKM TOXOPLASMOSIS TESTS TAX","","",GLOBAL)
+5 DO LOINC^BKMIXX(DFN,"BKM TOXOPLASMOSIS LOINC CODES","","",GLOBAL)
+6 SET GLOBAL="BKMT(""TOX"",VSTDT,TEST,""CPT"")"
+7 DO CPTTAX^BKMIXX(DFN,"BKM TOXOPLASMOSIS CPTS","","",GLOBAL)
+8 ; Print results
+9 DO LTAXPRT("TOX",1,1,,,,1)
+10 ; If no results found check refusal file
+11 IF '$DATA(BKMT("TOX"))
Begin DoDot:1
+12 SET GLOBAL="BKMT(""TOX"",VSTDT,TEST,""LAB"")"
+13 DO REFUSAL^BKMIXX2(DFN,60,"BKM TOXOPLASMOSIS LOINC CODES","","",GLOBAL)
+14 DO REFUSAL^BKMIXX2(DFN,60,"BKM TOXOPLASMOSIS TESTS TAX","","",GLOBAL)
+15 ; Print results
+16 DO LTAXPRT("TOX",1,1,1)
End DoDot:1
+17 KILL BKMT("TOX")
+18 IF LINE'=""
DO UPD^BKMVSUP
+19 QUIT
COC(DFN) ; EP - Retrieve Cocci taxonomies
+1 SET LINE=" Cocci: "
+2 KILL BKMT("COC")
+3 SET GLOBAL="BKMT(""COC"",VSTDT,TEST,""LAB"")"
+4 ;***
DO LABTAX^BKMIXX(DFN,"BKM COCCI ANTIBODY TAX","","",GLOBAL)
+5 DO LOINC^BKMIXX(DFN,"BKM COCCI ANTIBODY LOINC CODES","","",GLOBAL)
+6 SET GLOBAL="BKMT(""COC"",VSTDT,TEST,""CPT"")"
+7 DO CPTTAX^BKMIXX(DFN,"BKM COCCI ANTIBODY CPTS","","",GLOBAL)
+8 ; Print results
+9 IF $DATA(BKMT("COC"))
DO LTAXPRT("COC",1,1,,,,1)
QUIT
+10 ; Check refusals
+11 SET GLOBAL="BKMT(""COC"",VSTDT,TEST,""LAB"")"
+12 DO REFUSAL^BKMIXX2(DFN,60,"BKM COCCI ANTIBODY LOINC CODES","","",GLOBAL)
+13 DO REFUSAL^BKMIXX2(DFN,60,"BKM COCCI ANTIBODY TAX","","",GLOBAL)
+14 ; Print results
+15 DO LTAXPRT("COC",1,1,1)
+16 KILL BKMT("COC")
+17 IF LINE'=""
DO UPD^BKMVSUP
+18 QUIT
PPD(DFN) ; EP - Retrieve PPD taxonomies (T.21)
+1 SET LINE=" PPD: "
+2 KILL BKMT("PPD")
+3 SET GLOBAL="BKMT(""PPD"",VSTDT,TEST,""LAB"")"
+4 ;***
DO LABTAX^BKMIXX(DFN,"BKM PPD TAX","","",GLOBAL)
+5 DO LOINC^BKMIXX(DFN,"BKM PPD LOINC CODES","","",GLOBAL)
+6 SET GLOBAL="BKMT(""PPD"",VSTDT,TEST,""CPT"")"
+7 DO CPTTAX^BKMIXX(DFN,"BKM PPD CPTS","","",GLOBAL)
+8 SET GLOBAL="BKMT(""PPD"",VSTDT,TEST,""CVX"")"
+9 DO CVXTAX^BKMIXX1(DFN,"BKM PPD CVX CODES","","",GLOBAL)
+10 IF $DATA(BKMT("PPD"))
DO LTAXPRT("PPD",1,1,,,,1)
+11 IF '$DATA(BKMT("PPD"))
Begin DoDot:1
+12 ; If patient had no PPD T.21 in Labs, also check Skin Tests.
+13 SET GLOBAL="BKMT(""PPD"",VSTDT,TEST,""SKIN"")"
+14 DO SKNTAX^BKMIXX1(DFN,"21","","",GLOBAL)
+15 ; Following code was modified to display Result and Reading in that order
+16 IF $DATA(BKMT("PPD"))
Begin DoDot:2
+17 NEW BKMTL
+18 SET BKMTL="BKMT(""PPD"")"
+19 FOR
SET BKMTL=$QUERY(@BKMTL)
IF $PIECE(BKMTL,",")'="BKMT(""PPD"""
QUIT
Begin DoDot:3
+20 IF $PIECE(@BKMTL,U,2)]""
SET @BKMTL=$PIECE(@BKMTL,U,2)_" "_$PIECE(@BKMTL,U)
End DoDot:3
+21 DO LTAXPRT("PPD",1,1)
End DoDot:2
QUIT
+22 ; If nothing found check diagnosis taxonomy BKM PPD ICDS and include the text "(by Diagnosis)"
+23 SET GLOBAL="BKMT(""PPD"",VSTDT,TEST,""ICD"")"
+24 DO ICDTAX^BKMIXX1(DFN,"BKM PPD ICDS","","",GLOBAL)
+25 IF $DATA(BKMT("PPD"))
DO LTAXPRT("PPD",1,1,"",""," (by Diagnosis)")
QUIT
+26 ; Check refusals
+27 SET GLOBAL="BKMT(""PPD"",VSTDT,TEST,""LAB"")"
+28 DO REFUSAL^BKMIXX2(DFN,60,"BKM PPD LOINC CODES","","",GLOBAL)
+29 DO REFUSAL^BKMIXX2(DFN,60,"BKM PPD TAX","","",GLOBAL)
+30 DO REFUSAL^BKMIXX2(DFN,9999999.14,"BKM PPD CVX CODES","","",GLOBAL)
+31 DO REFUSAL^BKMIXX2(DFN,9999999.28,"21","","",GLOBAL)
+32 ; Print results
+33 DO LTAXPRT("PPD",1,1,1)
End DoDot:1
+34 KILL BKMT("PPD")
+35 IF LINE'=""
DO UPD^BKMVSUP
+36 QUIT
PHENO(DFN) ; EP - Retrieve HIV Phenotype Taxonomies (T.16)
+1 SET LINE=" HIV Phenotype: "
+2 KILL BKMT("PHENO")
+3 SET GLOBAL="BKMT(""PHENO"",VSTDT,TEST,""LAB"")"
+4 DO LABTAX^BKMIXX(DFN,"BKMV HIV PHENOTYPE TESTS TAX","","",GLOBAL)
+5 SET GLOBAL="BKMT(""PHENO"",VSTDT,TEST,""CPT"")"
+6 DO CPTTAX^BKMIXX(DFN,"BKMV HIV PHENOTYPE CPTS","","",GLOBAL)
+7 ; Print results
+8 IF $DATA(BKMT("PHENO"))
DO LTAXPRT("PHENO",5)
IF LINE'=""
DO UPD^BKMVSUP
QUIT
+9 ;I $D(BKMT("PHENO")) D LTAXPRT("PHENO",1,1) Q
+10 KILL BKMT("PHENO")
+11 IF LINE'=""
DO UPD^BKMVSUP
+12 QUIT
GENO(DFN) ; EP - Retrieve HIV Genotype Taxonomies
+1 SET LINE=" HIV Genotype: "
+2 KILL BKMT("GENO")
+3 SET GLOBAL="BKMT(""GENO"",VSTDT,TEST,""LAB"")"
+4 DO LABTAX^BKMIXX(DFN,"BKMV HIV GENOTYPE TESTS TAX","","",GLOBAL)
+5 SET GLOBAL="BKMT(""GENO"",VSTDT,TEST,""CPT"")"
+6 DO CPTTAX^BKMIXX(DFN,"BKMV HIV GENOTYPE CPTS","","",GLOBAL)
+7 ; Print results
+8 IF $DATA(BKMT("GENO"))
DO LTAXPRT("GENO",5)
IF LINE'=""
DO UPD^BKMVSUP
QUIT
+9 ;I $D(BKMT("GENO")) D LTAXPRT("GENO",1,1) Q
+10 KILL BKMT("GENO")
+11 IF LINE'=""
DO UPD^BKMVSUP
+12 QUIT
LTAXPRT(TYP,MAX,RES,REF,TBEF,TAFT,ONE,DTP) ; EP - Print lab related taxonomies for a patient
+1 ;
+2 ; TYP = Type of test (subscript in BKMT array)
+3 ; MAX = Maximum number of results to print
+4 ; $G(RES)=1 - Print results
+5 ; TBEF = text before
+6 ; REF = Refusal flag
+7 ; TAFT = text after
+8 ; ONE = Only display one result per day
+9 ; DTP = Date text - replaces standard "Date: " display
+10 ;
+11 NEW LDT,CNT,Y,TST,TYPE,END
+12 SET MAX=$GET(MAX,1)
SET REF=$GET(REF)
SET ONE=$GET(ONE)
SET RES=$GET(RES)
SET DTP=$GET(DTP)
+13 SET (LDT,CNT)=""
+14 FOR
SET LDT=$ORDER(BKMT(TYP,LDT),-1)
IF 'LDT
QUIT
Begin DoDot:1
+15 SET Y=$PIECE($$FMTE^XLFDT(LDT,"5Z"),"@")
+16 IF RES
IF 'ONE
IF 'REF
DO GETRES(TYP,LDT)
+17 IF ONE
DO ONERES(TYP,LDT)
+18 SET TST=""
+19 FOR
SET TST=$ORDER(BKMT(TYP,LDT,TST))
IF TST=""
QUIT
Begin DoDot:2
+20 SET TYPE=""
+21 FOR
SET TYPE=$ORDER(BKMT(TYP,LDT,TST,TYPE))
IF TYPE=""
QUIT
SET CNT=CNT+1
IF CNT>MAX
QUIT
Begin DoDot:3
+22 SET LINE=$$LINE^BKMVSUP(LINE,$SELECT(DTP]"":DTP,1:"Date: "),24)_Y
+23 IF RES
Begin DoDot:4
+24 SET LINE=$$LINE^BKMVSUP(LINE,"",41)
+25 IF $GET(TBEF)]""
SET LINE=LINE_TBEF
+26 IF REF
SET LINE=LINE_"[Refusal type: "_$EXTRACT($PIECE(BKMT(TYP,LDT,TST,TYPE),U),1,37)_"]"
+27 IF '$TEST
SET LINE=LINE_"Result: "_$EXTRACT($PIECE(BKMT(TYP,LDT,TST,TYPE),U),1,37)
+28 IF $GET(TAFT)]""
SET LINE=LINE_TAFT
+29 IF CNT<MAX
DO UPD^BKMVSUP
+30 IF LNCNT>MAXCT
DO NEWPG^BKMVSUP
End DoDot:4
+31 IF 'RES
IF CNT<MAX
Begin DoDot:4
+32 IF $ORDER(BKMT(TYP,LDT),-1)!($ORDER(BKMT(TYP,LDT,TST,TYPE))]"")!($ORDER(BKMT(TYP,LDT,TST))]"")
DO UPD^BKMVSUP
End DoDot:4
End DoDot:3
End DoDot:2
IF CNT>MAX
QUIT
End DoDot:1
IF CNT>MAX
QUIT
+33 IF CNT
QUIT
+34 IF LNCNT>MAXCT
DO NEWPG^BKMVSUP
+35 QUIT
+36 ;
ONERES(TYP,LDT) ; Display only one result per day
+1 ; Pare down array to the one entry to be displayed
+2 NEW STOP,TST,TYPE,RES,LDTTM
O1 SET (STOP,TST)=""
+1 FOR
SET TST=$ORDER(BKMT(TYP,LDT,TST))
IF TST=""
QUIT
Begin DoDot:1
+2 SET TYPE=""
+3 FOR
SET TYPE=$ORDER(BKMT(TYP,LDT,TST,TYPE))
IF TYPE=""
QUIT
Begin DoDot:2
+4 SET RES=BKMT(TYP,LDT,TST,TYPE)
+5 IF $PIECE(RES,U)'=""
Begin DoDot:3
+6 KILL BKMT(TYP,LDT)
SET BKMT(TYP,LDT,TST,TYPE)=RES
+7 ; Remove other entries for this date
+8 SET LDTTM=LDT
+9 FOR
SET LDTTM=$ORDER(BKMT(TYP,LDTTM),-1)
IF LDTTM\1'=(LDT\1)
QUIT
KILL BKMT(TYP,LDTTM)
End DoDot:3
SET STOP=1
QUIT
End DoDot:2
IF STOP
QUIT
End DoDot:1
IF STOP
QUIT
+10 IF STOP
QUIT
+11 ; Check remaining entries on this date for results
+12 SET LDTTM=$ORDER(BKMT(TYP,LDT),-1)
+13 IF LDTTM\1=(LDT\1)
KILL BKMT(TYP,LDT)
SET LDT=LDTTM
GOTO O1
+14 ; No results found - save one entry
+15 SET TST=$ORDER(BKMT(TYP,LDT,""))
IF TST=""
QUIT
+16 SET TYPE=$ORDER(BKMT(TYP,LDT,TST,""))
IF TYPE=""
QUIT
+17 SET RES=$GET(BKMT(TYP,LDT,TST,TYPE))
+18 KILL BKMT(TYP,LDT)
SET BKMT(TYP,LDT,TST,TYPE)=RES
+19 QUIT
+20 ;
GETRES(TYP,LDT) ; If more than one entry/day get entry with result
+1 NEW TEST,LPEND
+2 SET LPEND="BKMT("""_TYP_""","_LDT
SET TEST=LPEND_")"
+3 ; Loop through entries for the date and remove any tests w/o results until you either
+4 ; find a test with a result or get to the last test for the date
+5 FOR
SET TEST=$QUERY(@TEST)
IF $PIECE(TEST,",",1,2)'=LPEND
QUIT
IF @TEST]""
QUIT
Begin DoDot:1
+6 ; If this isn't the last test for the date and there is no result remove it
+7 IF $PIECE($QUERY(@TEST),",",1,2)=LPEND
KILL @TEST
End DoDot:1
+8 QUIT
+9 ;
XIT ; QUIT POINT
+1 QUIT
