BKMVSUP1.m

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)