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

BQICAEP2.m

Go to the documentation of this file. 
  1. BQICAEP2 ;GDIT/HS/ALA-Dept of EPI Comm Alert Logic ; 03 Oct 2011  12:26 PM
  1.  ;;2.6;ICARE MANAGEMENT SYSTEM;;Jul 07, 2017;Build 72
  1.  ;
  1.  ;
  1. MEAS(BQDFN,RESULT) ;EP - Measles
  1.  NEW UID,TREF,TAX,X
  1.  S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)
  1.  K RESULT
  1.  S RESULT(1)=0,CT=1
  1.  S TREF=$NA(^TMP("BQITAX",$J)) K @TREF
  1.  F TAX="BQI MEASLES ALERT LOINCS" D BLD^BQITUTL(TAX,.TREF)
  1.  F TAX="BQI MEASLES ALERT TAX" D BLD^BQITUTL(TAX,.TREF,"L")
  1.  S SEARCH(1)="POS"_U_"=",SEARCH(2)="1.09"_U_">"
  1.  S X=$$LAB^BQICAUTL(TMFRAME,0,BQDFN,"",.SEARCH,.TREF)
  1.  I X D LB^BQICAEP1(X,CT)
  1.  K SEARCH,@TREF
  1.  Q
  1.  ;
  1. MEN(BQDFN,RESULT) ;EP - Meningitis
  1.  NEW UID,TREF,TAX,X
  1.  S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)
  1.  K RESULT
  1.  S RESULT(1)=0,CT=1
  1.  S TREF=$NA(^TMP("BQITAX",$J)) K @TREF
  1.  F TAX="BQI MENINGITIS QUAL TEST LOINC","BQI MENINGITIS ID SPEC LOINC" D BLD^BQITUTL(TAX,.TREF)
  1.  F TAX="BQI MENINGITIS GRAM STAIN LNC","BQI MENINGITIS QUAN LOINC" D BLD^BQITUTL(TAX,.TREF)
  1.  F TAX="BQI MENINGITIS QUAL TEST TAX","BQI MENINGITIS GRAM STAIN TAX" D BLD^BQITUTL(TAX,.TREF,"L")
  1.  F TAX="BQI MENINGITIS ID SPEC TAX","BQI MENINGITIS QUAN TAX" D BLD^BQITUTL(TAX,.TREF,"L")
  1.  S SEARCH(1)="POS"_U_"=",SEARCH(2)="0"_U_">"
  1.  S X=$$LAB^BQICAUTL(TMFRAME,0,BQDFN,"",.SEARCH,.TREF)
  1.  I X D LB^BQICAEP1(X,CT)
  1.  K SEARCH,@TREF
  1.  Q
  1.  ;
  1. FLU(BQDFN,RESULT) ;EP - Influenza
  1.  NEW UID,TREF,TAX,X
  1.  S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)
  1.  K RESULT
  1.  S RESULT(1)=0,CT=1
  1.  S SEARCH(1)="POS"_U_"="
  1.  S TREF=$NA(^TMP("BQITAX",$J)) K @TREF
  1.  S TAX="SURVEILLANCE RAPID FLU TESTS" D BLD^BQITUTL(TAX,.TREF,"L")
  1.  S TAX="SURVEILLANCE RAPID FLU LOINC" D BLD^BQITUTL(TAX,.TREF)
  1.  S X=$$LAB^BQICAUTL(TMFRAME,0,BQDFN,"",.SEARCH,.TREF)
  1.  I X D LB^BQICAEP1(X,CT)
  1.  K SEARCH,@TREF
  1.  Q
  1.  ;
  1. FLUD(BQDFN,RESULT) ;EP - Flu Diagnosis
  1.  NEW UID,TREF,TAX,X
  1.  S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)
  1.  ;S TIME="T-14M"
  1.  S X=$$TAX^BQITRUTL(TMFRAME,"BQI ILI NO TMP NEEDED DXS",1,BQDFN,9000010.07,"","",.TREF)
  1.  I X D DXF(X) K @TREF Q
  1.  ;
  1.  S X=$$TAX^BQITRUTL(TMFRAME,"SURVEILLANCE ILI",1,BQDFN,9000010.07,"","",.TREF)
  1.  I 'X Q
  1.  S VISIT=$P(X,U,4)
  1.  S X1=$$MEAS^BQICAUTL(BQDFN,"TMP",VISIT,"100",">") I 'X1 Q
  1.  D DXF(X),MSF(X1)
  1.  K @TREF
  1.  Q
  1.  ;
  1. TUB(BQDFN,RESULT) ; EP - Tuberculosis
  1.  NEW UID,TREF,TAX,X,BDX,BX
  1.  S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)
  1.  K RESULT
  1.  S RESULT(1)=0,CT=1
  1.  S TREF=$NA(^TMP("BQITAX",$J)) K @TREF
  1.  S BDXX=$$TAX^BQITRUTL(TMFRAME,"BQI TUBERCULOSIS DXS",1,BQDFN,9000010.07,"","",.TREF)
  1.  I BDXX D DXF(BDXX)
  1.  K @TREF
  1.  ;
  1.  ; Check for positive skin test
  1.  S BSXX=$$SKTST(BQDFN,"T-60")
  1.  I BSXX D
  1.  . NEW VSDTM,TIEN,VISIT,IEN
  1.  . S VSDTM=$P(BSXX,U,2),VISIT=$P(BSXX,U,4),IEN=$P(BSXX,U,5),TIEN=$P(^AUPNVSK(IEN,0),U,1)
  1.  . S @DATA@(COMM,ALRT,BQDFN,"SK",VSDTM,TIEN)=VISIT_U_IEN_U_"9000010.12"
  1.  ;
  1.  ; Check for BCG or other immunization
  1.  S BX=$$BCG(BQDFN,"")
  1.  ;
  1.  F TAX="BKM PPD LOINC CODES","BQI PPD DIAMETER LOINC" D BLD^BQITUTL(TAX,.TREF)
  1.  F TAX="BKM PPD TAX","BQI PPD DIAMETER TAX" D BLD^BQITUTL(TAX,.TREF,"L")
  1.  F TAX="BQI TB GAMMA REL QUAL TEST TAX","BQI TB GAMMA REL QUANT TEST TX" D BLD^BQITUTL(TAX,.TREF,"L")
  1.  F TAX="BQI TB GAMMA REL QUAL TEST LNC","BQI TB GAMMA REL QUANT TEST LC" D BLD^BQITUTL(TAX,.TREF)
  1.  S SEARCH(1)="POS"_U_"=",SEARCH(2)="0"_U_">"
  1.  S X=$$LAB^BQICAUTL(TMFRAME,0,BQDFN,"",.SEARCH,.TREF)
  1.  K SEARCH,@TREF
  1.  I X!(BSXX),'BX,BDXX D LB^BQICAEP1(X,CT) Q
  1.  ;
  1.  K @TREF
  1.  F TAX="BQI TB RNA DNA QUAL TEST LOINC","BQI TB RNA DNA QUANT TEST LNC" D BLD^BQITUTL(TAX,.TREF)
  1.  F TAX="BQI TB RNA DNA QUAL TEST TAX","BQI TB RNA DNA QUANT TEST TAX" D BLD^BQITUTL(TAX,.TREF,"L")
  1.  F TAX="BQI TB SPECIFIC AFB TEST LOINC","BQI TB NONSPEC AFB TEST LOINC" D BLD^BQITUTL(TAX,.TREF)
  1.  F TAX="BQI TB SPECIFIC AFB TEST TAX","BQI TB NONSPEC AFB TEST TAX" D BLD^BQITUTL(TAX,.TREF,"L")
  1.  S SEARCH(1)="POS"_U_"=",SEARCH(2)="0"_U_">"
  1.  S X=$$LAB^BQICAUTL(TMFRAME,0,BQDFN,"",.SEARCH,.TREF)
  1.  I X,'BX,BDXX D LB^BQICAEP1(X,CT)
  1.  K SEARCH,@TREF
  1.  Q
  1.  ;
  1. SYP(BQDFN,RESULT) ;EP - Syphilis
  1.  NEW UID,TREF,TAX,XTP,XSC,DATE
  1.  S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)
  1.  K RESULT
  1.  S RESULT(1)=0,CT=1
  1.  S TREF=$NA(^TMP("BQITAX",$J)) K @TREF
  1.  ;
  1.  D
  1.  . S TAX="BQI SYPHILIS TP-AB LOINC" D BLD^BQITUTL(TAX,.TREF)
  1.  . S TAX="BQI SYPHILIS TP-AB TEST TAX" D BLD^BQITUTL(TAX,.TREF,"L")
  1.  . S SEARCH(1)="POS"_U_"=",SEARCH(2)="0"_U_">"
  1.  . S XTP=$$LAB^BQICAUTL(TMFRAME,0,BQDFN,"",.SEARCH,.TREF)
  1.  . K @TREF
  1.  . S TAX="BQI SYPHILIS REAGIN LOINC" D BLD^BQITUTL(TAX,.TREF)
  1.  . S TAX="BQI SYPHILIS REAGIN TEST TAX" D BLD^BQITUTL(TAX,.TREF,"L")
  1.  . S SEARCH(1)="POS"_U_"=",SEARCH(2)="0"_U_">",DATE=$P(XTP,U,2)
  1.  . S XSC=$$LBB^BQICAUTL(30,0,DATE,BQDFN,"",.SEARCH,.TREF)
  1.  . K @TREF
  1.  . I 'XTP,'XSC Q
  1.  . I XSC D
  1.  .. NEW XBGS,XBES
  1.  .. S XBGS=$P(XSC,U,2),XBES=DT
  1.  .. S XFPS=$$TAX^BQITRUTL("","BQI SYPHILIS FALSE POS DXS",1,BQDFN,9000010.07,"","",.TREF,XBGS,XBES)
  1.  .. I XFPS S XSC=0
  1.  . I XTP D
  1.  .. S XBGT=$P(XTP,U,2),XBET=DT
  1.  .. S XFPT=$$TAX^BQITRUTL("","BQI SYPHILIS FALSE POS DXS",1,BQDFN,9000010.07,"","",.TREF,XBGT,XBET)
  1.  .. I XFPT S XTP=0
  1.  ;
  1.  I XTP,XSC D
  1.  . D LB^BQICAEP1(XTP,CT) S CT=CT+1
  1.  . D LB^BQICAEP1(XSC,CT)
  1.  K SEARCH,@TREF
  1.  Q
  1.  ;
  1. HIB(BQDFN,RESULT) ;EP - HIB Flu
  1.  NEW UID,TREF,TAX,X
  1.  S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)
  1.  K RESULT
  1.  S RESULT(1)=0,CT=1
  1.  S TREF=$NA(^TMP("BQITAX",$J)) K @TREF
  1.  F TAX="BQI HIB QUAL TEST LOINC","BQI HIB CULTURE TEST LOINC","BQI HIB QUANT TEST LOINC" D BLD^BQITUTL(TAX,.TREF)
  1.  F TAX="BQI HIB QUAL TEST TAX","BQI HIB CULTURE TEST TAX","BQI HIB QUANT TEST TAX" D BLD^BQITUTL(TAX,.TREF,"L")
  1.  S SEARCH(1)="POS"_U_"=",SEARCH(2)="0"_U_">"
  1.  S X=$$LAB^BQICAUTL(TMFRAME,0,BQDFN,"",.SEARCH,.TREF)
  1.  I X D LB^BQICAEP1(X,CT)
  1.  K SEARCH,@TREF
  1.  Q
  1.  ;
  1. DXF(BQX) ;EP - Diagnosis
  1.  NEW VSDTM,TIEN,VISIT,IEN
  1.  S VSDTM=$P(BQX,U,2),VISIT=$P(BQX,U,4),IEN=$P(BQX,U,5),TIEN=$P(^AUPNVPOV(IEN,0),U,1)
  1.  S @DATA@(COMM,ALRT,BQDFN,"DX",VSDTM,TIEN)=VISIT_U_IEN_U_"9000010.07"
  1.  Q
  1.  ;
  1. MSF(BQX) ;EP - Measurement
  1.  NEW VSDTM,TIEN,VISIT,IEN
  1.  S VSDTM=$P(BQX,U,2),VISIT=$P(BQX,U,4),IEN=$P(BQX,U,5),TIEN=$P(^AUPNVMSR(IEN,0),U,1)
  1.  S @DATA@(COMM,ALRT,BQDFN,"MS",VSDTM,TIEN)=VISIT_U_IEN_U_"9000010.01"
  1.  Q
  1.  ;
  1. BCG(BQDFN,TMFRAME) ;EP - BCG Vaccination
  1.  ; immunization BCG or 19
  1.  ; cpt codes 90728 or 90585
  1.  ; icd9 diagnosis V03.2
  1.  ; icd9 procedure 99.33
  1.  ;
  1.  NEW ENDT,STDT,BGDT,BQIM,QFL,IEN,VIEN,TIEN,RES,TREF,BPOV
  1.  S RES=0
  1.  I $G(TMFRAME)'="" S ENDT=(9999999-$$DATE^BQIUL1(TMFRAME)),BGDT=9999999-DT,STDT=ENDT-.0001
  1.  I $G(TMFRAME)="" S STDT="",ENDT=""
  1.  ;
  1.  ; Check BCG immunization
  1.  S BQIM=$O(^AUTTIMM("B","BCG","")) I BQIM'="" D
  1.  . S QFL=0 I ENDT="" S ENDT=$O(^AUPNVIMM("AA",BQDFN,BQIM,STDT),-1)
  1.  . F  S STDT=$O(^AUPNVIMM("AA",BQDFN,BQIM,STDT)) Q:STDT=""!(STDT>ENDT)  D  Q:QFL
  1.  .. S IEN=""
  1.  .. F  S IEN=$O(^AUPNVIMM("AA",BQDFN,BQIM,STDT,IEN)) Q:IEN=""  D  Q:QFL
  1.  ... S VIEN=$P($G(^AUPNVIMM(IEN,0)),U,3)
  1.  ... S RES=1_U_$$FMTE^BQIUL1((9999999-STDT))_U_U_VIEN_U_IEN_U
  1.  ;
  1.  I RES Q RES
  1.  ; check for ICD9 diagnosis
  1.  S TREF="BQILST" K @TREF
  1.  D BLDSV^BQITUTL(80,"V03.2 ",TREF)
  1.  I $G(TMFRAME)'="" S ENDT=(9999999-$$DATE^BQIUL1(TMFRAME)),BGDT=9999999-DT,STDT=ENDT-.0001
  1.  I $G(TMFRAME)="" S STDT="",ENDT=""
  1.  I ENDT="" S ENDT=$O(^AUPNVPOV("AA",BQDFN,""),-1)
  1.  F  S STDT=$O(^AUPNVPOV("AA",BQDFN,STDT)) Q:STDT=""!(STDT>ENDT)  D  Q:QFL
  1.  . S IEN=""
  1.  . F  S IEN=$O(^AUPNVPOV("AA",BQDFN,STDT,IEN)) Q:IEN=""  D  Q:QFL
  1.  .. S BPOV=$P($G(^AUPNVPOV(IEN,0)),U,1) I BPOV="" Q
  1.  .. I '$D(@TREF@(BPOV)) Q
  1.  .. S VIEN=$P(^AUPNVPOV(IEN,0),U,3)
  1.  .. S RES=1_U_$$FMTE^BQIUL1((9999999-STDT))_U_U_VIEN_U_IEN_U
  1.  ;
  1.  I RES Q RES
  1.  ;
  1.  ; Check for CPT codes
  1.  S TREF="BQILST" K @TREF
  1.  D BLDSV^BQITUTL(81,"90585 ",TREF),BLDSV^BQITUTL(81,"90728 ",TREF)
  1.  S TIEN="",QFL=0
  1.  F  S TIEN=$O(@TREF@(TIEN)) Q:TIEN=""  D  Q:QFL
  1.  . I $G(TMFRAME)'="" S ENDT=(9999999-$$DATE^BQIUL1(TMFRAME)),BGDT=9999999-DT,STDT=ENDT-.0001
  1.  . I $G(TMFRAME)="" S STDT="",ENDT=""
  1.  . I ENDT="" S ENDT=$O(^AUPNVCPT("AA",BQDFN,TIEN,""),-1)
  1.  . F  S STDT=$O(^AUPNVCPT("AA",BQDFN,TIEN,STDT)) Q:STDT=""!(STDT>ENDT)  D  Q:QFL
  1.  .. S IEN=""
  1.  .. F  S IEN=$O(^AUPNVCPT("AA",BQDFN,TIEN,STDT,IEN)) Q:IEN=""  D  Q:QFL
  1.  ... S VIEN=$P($G(^AUPNVCPT(IEN,0)),U,3)
  1.  ... S RES=1_U_$$FMTE^BQIUL1((9999999-STDT))_U_U_VIEN_U_IEN_U
  1.  ;
  1.  I RES Q RES
  1.  ;
  1.  ; Check for procedure
  1.  S TREF="BQILST" K @TREF
  1.  D BLDSV^BQITUTL(80.1,"99.33 ",TREF)
  1.  I $G(TMFRAME)'="" S ENDT=(9999999-$$DATE^BQIUL1(TMFRAME)),BGDT=9999999-DT,STDT=ENDT-.0001
  1.  I $G(TMFRAME)="" S STDT="",ENDT=""
  1.  I ENDT="" S ENDT=$O(^AUPNVPRC("AA",BQDFN,""),-1)
  1.  F  S STDT=$O(^AUPNVPRC("AA",BQDFN,STDT)) Q:STDT=""!(STDT>ENDT)  D  Q:QFL
  1.  . S IEN=""
  1.  . F  S IEN=$O(^AUPNVPRC("AA",BQDFN,STDT,IEN)) Q:IEN=""  D  Q:QFL
  1.  .. S BPOV=$P($G(^AUPNVPRC(IEN,0)),U,1) I BPOV="" Q
  1.  .. I '$D(@TREF@(BPOV)) Q
  1.  .. S VIEN=$P(^AUPNVPRC(IEN,0),U,3)
  1.  .. S RES=1_U_$$FMTE^BQIUL1((9999999-STDT))_U_U_VIEN_U_IEN_U
  1.  K @TREF
  1.  Q RES
  1.  ;
  1. SKTST(BQDFN,TMFRAME) ;EP - Skin Test
  1.  NEW SKN,ENDT,STDT,BGDT,IEN,VIEN,RES,VALUE
  1.  S SKN=$$FIND1^DIC(9999999.28,,"X","PPD")
  1.  S RES=0
  1.  I $G(TMFRAME)'="" S ENDT=(9999999-$$DATE^BQIUL1(TMFRAME)),BGDT=9999999-DT,STDT=ENDT-.0001
  1.  I $G(TMFRAME)="" S STDT="",ENDT=""
  1.  I ENDT="" S ENDT=$O(^AUPNVSK("AA",BQDFN,SKN,""),-1)
  1.  F  S STDT=$O(^AUPNVSK("AA",BQDFN,SKN,STDT)) Q:STDT=""!(STDT>ENDT)  D  Q:QFL
  1.  . S IEN=""
  1.  . F  S IEN=$O(^AUPNVSK("AA",BQDFN,SKN,STDT,IEN)) Q:IEN=""  D  Q:QFL
  1.  .. S VIEN=$P($G(^AUPNVSK(IEN,0)),U,3) I VIEN="" Q
  1.  .. ; If the reading is greater than 15 mm, then it is positive
  1.  .. S VALUE=+$P(^AUPNVSK(IEN,0),U,5)'>15 Q
  1.  .. S RES=1_U_$$FMTE^BQIUL1((9999999-STDT))_U_U_VIEN_U_IEN_U_"9000010.12"
  1.  Q RES