Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: BKMVF32

BKMVF32.m

Go to the documentation of this file. 
  1. 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
  1.  QUIT
  1.  ; KJH - 04/13/2005 - Split from original routine due to size restrictions.
  1.  ;
  1. POSITIVE(RESULT) ; EP - If the result is positive return a 1 else return a 0.
  1.  I $E(RESULT,1)="+" Q 1
  1.  I $E(RESULT,1)=">" Q 1
  1.  S RESULT=$$UP^XLFSTR(RESULT)
  1.  I RESULT="P" Q 1 ; Positive
  1.  I RESULT="R" Q 1 ; Reactive
  1.  I RESULT="WR" Q 1 ; Weakly Reactive
  1.  I RESULT="REACTIVE" Q 1 ; Reactive
  1.  I RESULT="WEAKLY REACTIVE" Q 1 ; Weakly Reactive
  1.  ; Result field contains a word that starts with "POS" or "pos"
  1.  N FLG,I
  1.  S FLG=0
  1.  I $E(RESULT,1,3)="POS" S FLG=1 Q FLG
  1.  F I=1:1:$L(RESULT) I $E(RESULT,I)?1P,$E(RESULT,I+1,I+3)="POS" S FLG=1 Q
  1.  Q FLG
  1.  ;I RESULT["POS" Q 1 ; Positive
  1.  ;Q 0
  1.  ;
  1. NEGATIVE(RESULT) ; EP - If the result is negative return a 1 else return a 0.
  1.  I $E(RESULT,1)="-" Q 1
  1.  ; **NOTE: Documentation does not specify if "<" is considered negative.
  1.  S RESULT=$$UP^XLFSTR(RESULT)
  1.  I RESULT="N" Q 1 ; Negative (or Non-Reactive)
  1.  I RESULT="NR" Q 1 ; Non-Reactive
  1.  I RESULT="NON-REACTIVE" Q 1 ; Non-Reactive
  1.  I RESULT="NON REACTIVE" Q 1 ; Non-Reactive
  1.  I RESULT="NONREACTIVE" Q 1 ; Non-Reactive
  1.  ; Result field contains a word that starts with "NEG" or "neg"
  1.  N FLG,I
  1.  S FLG=0
  1.  I $E(RESULT,1,3)="NEG" S FLG=1 Q FLG
  1.  F I=1:1:$L(RESULT) I $E(RESULT,I)?1P,$E(RESULT,I+1,I+3)="NEG" S FLG=1 Q
  1.  Q FLG
  1.  ;I RESULT["NEG" Q 1 ; Negative
  1.  ;Q 0
  1.  ;
  1. PPDPOS(RESULT) ; EP - If the result is positive return a 1 else return a 0.
  1.  ;                    This change is specific to PPD.
  1.  S RESULT=$$UP^XLFSTR(RESULT)
  1.  I RESULT="P" Q 1 ; Positive
  1.  I RESULT="R" Q 1 ; Reactive
  1.  I RESULT="WR" Q 1 ; Weakly Reactive
  1.  I RESULT="REACTIVE" Q 1 ; Reactive
  1.  I RESULT="WEAKLY REACTIVE" Q 1 ; Weakly Reactive
  1.  I RESULT="+" Q 1 ; Positive
  1.  I RESULT?.N,RESULT>4 Q 1 ; Positive numeric result
  1.  ; Result field contains a word that starts with "POS" or "pos"
  1.  N FLG,I
  1.  S FLG=0
  1.  I $E(RESULT,1,3)="POS" S FLG=1 Q FLG
  1.  F I=1:1:$L(RESULT) I $E(RESULT,I)?1P,$E(RESULT,I+1,I+3)="POS" S FLG=1 Q
  1.  Q FLG
  1.  ;
  1. PPDNEG(RESULT) ; EP - If the result is negative return a 1 else return a 0.
  1.  ;                    This change is specific to PPD.
  1.  ;I $E(RESULT,1)="-" Q 1
  1.  ; **NOTE: Documentation does not specify if "<" is considered negative.
  1.  S RESULT=$$UP^XLFSTR(RESULT)
  1.  I RESULT="N" Q 1 ; Negative (or Non-Reactive)
  1.  I RESULT="NR" Q 1 ; Non-Reactive
  1.  I RESULT="NON-REACTIVE" Q 1 ; Non-Reactive
  1.  I RESULT="NON REACTIVE" Q 1 ; Non-Reactive
  1.  I RESULT="NONREACTIVE" Q 1 ; Non-Reactive
  1.  I RESULT="-" Q 1 ; Negative
  1.  I RESULT?1.N,RESULT<5 Q 1 ; Negative numeric result
  1.  ; Result field contains a word that starts with "NEG" or "neg"
  1.  N FLG,I
  1.  S FLG=0
  1.  I $E(RESULT,1,3)="NEG" S FLG=1 Q FLG
  1.  F I=1:1:$L(RESULT) I $E(RESULT,I)?1P,$E(RESULT,I+1,I+3)="NEG" S FLG=1 Q
  1.  Q FLG
  1.  ; 
  1. ADDLINE(REM,ARRAY,TEXT,LAST,DUE,LASTTXT) ; EP - Update reminder output array
  1.  S ARRAY(REM)=$G(ARRAY(REM))+1
  1.  S ARRAY(REM,ARRAY(REM),0)=$G(TEXT)
  1.  S ARRAY(REM,ARRAY(REM),"LAST")=$G(LAST)
  1.  S ARRAY(REM,ARRAY(REM),"DUE")=$G(DUE)
  1.  S ARRAY(REM,ARRAY(REM),"LASTTXT")=$G(LASTTXT)
  1.  Q
  1.  ;
  1.  ; Check for any positive STD tests (other than the one specified in STD) after LDATE.
  1.  ; Check for any STD diagnoses  (other than the one specified in STD) after LDATE.
  1.  ; Valid values for STD are "CHLAMYDIA", "GONORRHEA", "SYPHILIS", "TRICHOMONIASIS" and "OTHER".
  1.  ; NOTE: "TRICHOMONIASIS" and "OTHER" are not likely to be used but are maintained for consistency.
  1. STDS(DFN,STD,LDATE) ;EP
  1.  NEW PDATE,PRCTEST,PRCDT,PRC,DDATE,LDATE1
  1.  ; Use the newer of LDATE or report date minus 365 days.
  1.  I $G(BDATE)="" S BDATE=DT
  1.  S LDATE1=$$FMADD^XLFDT(BDATE,-365)
  1.  I LDATE>LDATE1 S LDATE1=LDATE
  1.  S LDATE1=LDATE1\1_".2400" ;Start search on the next day
  1.  ; Chlamydia (T.3)
  1.  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
  1.  ; Gonorrhea (T.10)
  1.  I STD'="GONORRHEA" D LABCODES(DFN,"BKM GONORRHEA TEST TAX","BKM GONORRHEA LOINC CODES","BKM GONORRHEA TESTS CPTS","",LDATE1,"","","",.PDATE) I PDATE'="" Q 1
  1.  ; Syphilis (T.22)
  1.  I STD'="SYPHILIS" D LABCODES(DFN,"BKM RPR TAX","BKM RPR LOINC CODES","BKM RPR CPTS","",LDATE1,"","","",.PDATE) I PDATE'="" Q 1
  1.  ; Syphilis (T.9)
  1.  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
  1.  ;PRXM/HC/BHS - 04/19/2006 - Removed per IHS Issue # 1467
  1.  ; Trichomoniasis (T.24)
  1.  ;I STD'="TRICHOMONIASIS" D LABCODES(DFN,"BKM TRICH TESTS TAX","BKM TRICH LOINC CODES","","BKM TRICHOMONIASIS DXS",LDATE1,"","","",.PDATE) I PDATE'="" Q 1
  1.  ;PRXM/HC/KJH - 04/19/2006 - Removed per IHS Issue # 1460, 1464, 1465 and replaced with other POV diagnosis checks below.
  1.  ; Other STD (DX.9)
  1.  ;I STD'="OTHER" D LABCODES(DFN,"","","","BKM OTHER STD DXS",LDATE1,"","","",.PDATE) I PDATE'="" Q 1
  1.  ; Chlamydia (DX.2)
  1.  I STD'="CHLAMYDIA" D ICDTAX^BKMIXX1(DFN,"BKM CHLAMYDIA DXS","",LDATE1,"",.DDATE) I DDATE'="" Q 1
  1.  ; Gonorrhea (DX.4)
  1.  I STD'="GONORRHEA" D ICDTAX^BKMIXX1(DFN,"BKM GONORRHEA DXS","",LDATE1,"",.DDATE) I DDATE'="" Q 1
  1.  ; Syphilis (DX.11)
  1.  I STD'="SYPHILIS" D ICDTAX^BKMIXX1(DFN,"BKM SYPHILIS DXS","",LDATE1,"",.DDATE) I DDATE'="" Q 1
  1.  ; Trichomoniasis (DX.13)
  1.  I STD'="TRICHOMONIASIS" D ICDTAX^BKMIXX1(DFN,"BKM TRICHOMONIASIS DXS","",LDATE1,"",.DDATE) I DDATE'="" Q 1
  1.  ; Other STD (DX.9)
  1.  I STD'="OTHER" D ICDTAX^BKMIXX1(DFN,"BKM OTHER STD DXS","",LDATE1,"",.DDATE) I DDATE'="" Q 1
  1.  Q 0
  1.  ;
  1.  ; This function cycles through the V-Lab file checking
  1.  ; each lab, CPT4, ICD9, and LOINC associated with a DFN to
  1.  ; see if each is in an appropriate taxonomy, old enough,
  1.  ; and if required positive.
  1.  ;
  1.  ; DFN is the patient DFN from file 2 or 9000001.
  1.  ;
  1.  ; LABT is the text name of the lab taxonomy.
  1.  ; LOINCT is the text name of the LOINC taxonomy.
  1.  ; CPTT is the text name of the CPT taxonomy.
  1.  ; ICDT is the text name of the ICD9 taxonomy.
  1.  ;
  1.  ; BDATE is the base (starting) date for the search.
  1.  ;
  1.  ; IDATE is the date of the last item (LAB, LOINC, CPT, or ICD) passed by reference.
  1.  ;
  1.  ; LDATE is the date of the last LAB passed by reference.
  1.  ; LR if there is a LDATE then the LR will be equal to the result.
  1.  ; LV if there is a LDATE then the LV is the V Lab IEN.
  1.  ;
  1.  ; PDATE is the date of the last positive LAB passed by reference.
  1.  ; PR if there is a PDATE then the PR will be equal to the positive result.
  1.  ; PV if there is a PDATE then the PV is the V Lab IEN.
  1.  ;
  1.  ; NDATE is the date of the last negative LAB passed by reference.
  1.  ; NR if there is a NDATE then the NR will be equal to the negative result.
  1.  ; NV if there is a NDATE then the NV is the V Lab IEN.
  1.  ;
  1. LABCODES(DFN,LABT,LOINCT,CPTT,ICDT,BDATE,IDATE,LDATE,LR,PDATE,PR,NDATE,NR,ODATE,OR,OFLG) ;EP
  1.  ; EP - Retrieve lab codes.
  1.  N QDATE,QV,LV,TARGET,LABTEST,LAB,LABDT,RESULT
  1.  S LABT=$G(LABT,""),LOINCT=$G(LOINCT,""),CPTT=$G(CPTT,""),ICDT=$G(ICDT,""),OFLG=$G(OFLG,"")
  1.  S BDATE=$G(BDATE,""),IDATE=$G(IDATE,""),LDATE=$G(LDATE,""),PDATE=$G(PDATE,""),NDATE=$G(NDATE,""),ODATE=$G(ODATE,"")
  1.  S (LV,LR,PR,NR,OR)=""
  1.  S TARGET="LABTEST(VSTDT,TEST)"
  1.  S QDATE="",QV=""
  1.  D LABTAX^BKMIXX(DFN,LABT,"",BDATE,TARGET,.QDATE,.QV)
  1.  S IDATE=QDATE,LDATE=QDATE,LV=QV
  1.  S QDATE="",QV=""
  1.  D LOINC^BKMIXX(DFN,LOINCT,"",BDATE,TARGET,.QDATE,.QV)
  1.  I QDATE>IDATE S IDATE=QDATE,LDATE=QDATE,LV=QV
  1.  S QDATE="",QV=""
  1.  D CPTTAX^BKMIXX(DFN,CPTT,"",BDATE,TARGET,.QDATE,.QV)
  1.  I QDATE>IDATE S IDATE=QDATE,LDATE=QDATE,LV=QV
  1.  S QDATE="",QV=""
  1.  D ICDTAX^BKMIXX1(DFN,ICDT,"",BDATE,TARGET,.QDATE,.QV)
  1.  I QDATE>IDATE S IDATE=QDATE,LDATE=QDATE,LV=QV
  1.  I LV'="" S LR=LABTEST(LDATE,LV)
  1.  S LABDT=""
  1.  F  S LABDT=$O(LABTEST(LABDT),-1) Q:LABDT=""  D  I PDATE]"",NDATE]"" Q
  1.  . S LAB=""
  1.  . F  S LAB=$O(LABTEST(LABDT,LAB),-1) Q:LAB=""  D  I PDATE]"",NDATE]"" Q
  1.  . . S RESULT=$P(LABTEST(LABDT,LAB),U)
  1.  . . I PDATE="",$$POSITIVE^BKMVF32(RESULT) S PDATE=LABDT,PR=RESULT
  1.  . . I NDATE="",$$NEGATIVE^BKMVF32(RESULT) S NDATE=LABDT,NR=RESULT
  1.  . . I ODATE="",OFLG'="",@OFLG S ODATE=LABDT,OR=RESULT
  1.  . . Q
  1.  . Q
  1.  Q