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

BQITD08.m

Go to the documentation of this file. 
  1. BQITD08 ;PRXM/HC/ALA-HIV/AIDS ; 02 Mar 2006  1:17 PM
  1.  ;;2.1;ICARE MANAGEMENT SYSTEM;;Feb 07, 2011
  1.  Q
  1.  ;
  1. POP(BQARY,TGLOB) ; EP -- By population
  1.  ;
  1.  ;Description
  1.  ;  Finds all patients who meet the criteria for HIV/AIDS
  1.  ;Input
  1.  ;  BQARY - Array of taxonomies and other information
  1.  ;  TGLOB - Global where data is to be stored and passed back
  1.  ;          to calling routine
  1.  ;          Structure:
  1.  ;          TGLOB(DFN,"CRITERIA",criteria or taxonomy,visit or problem ien)=date/time
  1.  ;Variables
  1.  ;  TAX - Taxonomy name
  1.  ;  NIT - Number of iterations
  1.  ;  TMFRAME - Time frame of check
  1.  ;  FREF - File Number reference
  1.  ;  PLFLG - Problem File flag
  1.  ;  GREF - Global reference
  1.  ;  TREF - Taxonomy temp reference
  1.  ;
  1.  ;  Clean up all current entries
  1.  NEW DXNN,TDFN,DA,DIK,RGIEN
  1.  NEW PRIM,SERV,VSERV,OPRM
  1.  ;
  1.  N TAX,FREF,GREF,TMFRAME,EXDT,DTDIF,ENDT,TIEN,IEN,TDFN,VISIT
  1.  ;One diagnosis on Active Problem List (for POP)
  1.  S TMFRAME="",EXDT="",DTDIF="",ENDT=""
  1.  S FREF=9000010.07,GREF=$$ROOT^DILFD(FREF,"",1)
  1.  S TREF=$NA(^TMP("BQITAX",UID)),TMREF=$NA(^TMP("BQITMPD",UID))
  1.  K @TREF,@TMREF
  1.  S TAX="BGP HIV/AIDS DXS"
  1.  S PRIM=1,SERV="A;H"
  1.  D BLD^BQITUTL(TAX,TREF)
  1.  ;  For each entry in the taxonomy reference check problem file
  1.  S TIEN=0
  1.  F  S TIEN=$O(@TREF@(TIEN)) Q:'TIEN  D PRB^BQITDGN(TIEN,.TGLOB)
  1.  ;
  1.  ; At least 2 POVs ever at least 60 days apart (for POP)
  1.  ;    Note: BGP HIV/AIDS DX taxonomy data already loaded in TREF
  1.  D GETVST ; Get related visit data and set up criteria in temporary file
  1.  S TDFN=""
  1.  F  S TDFN=$O(@TMREF@(TDFN)) Q:TDFN=""  D
  1.  . Q:$D(@TGLOB@(TDFN))  ; Patient already identified
  1.  . D POV^BQITD081(TDFN,TGLOB,TMREF)
  1.  ;
  1.  ; At least 2 CD4/Viral Load lab tests in the past two years
  1.  ; at least 60 days apart (for POP)
  1.  N N
  1.  K BQITRY,@TMREF
  1.  S BQITRY(1)="BGP CD4 TAX^9000010.09^^T-24M"
  1.  S BQITRY(2)="BGP CD4 CPTS^9000010.18^^T-24M"
  1.  S BQITRY(3)="BGP CD4 LOINC CODES^9000010.09^^T-24M"
  1.  S BQITRY(4)="BGP HIV VIRAL LOAD TAX^9000010.09^^T-24M"
  1.  S BQITRY(5)="BGP HIV VIRAL LOAD CPTS^9000010.18^^T-24M"
  1.  S BQITRY(6)="BGP VIRAL LOAD LOINC CODES^9000010.09^^T-24M"
  1.  S N=0
  1.  F  S N=$O(BQITRY(N)) Q:'N  D
  1.  . K @TREF
  1.  . S TAX=$P(BQITRY(N),U,1),FREF=$P(BQITRY(N),U,2),GREF=$$ROOT^DILFD(FREF,"",1)
  1.  . S TMFRAME=$P(BQITRY(N),U,4),ENDT=""
  1.  . D BLD^BQITUTL(TAX,TREF)
  1.  . D GETVST ; Get related visit data and set up criteria in temporary file
  1.  S TDFN=""
  1.  F  S TDFN=$O(@TMREF@(TDFN)) Q:TDFN=""  D
  1.  . Q:$D(@TGLOB@(TDFN))  ; Patient already identified
  1.  . D CDVL^BQITD081(TDFN,TGLOB,TMREF)
  1.  K @TMREF
  1.  ;
  1.  ; Positive HIV Screening (for POP)
  1.  S FREF=9000010.09,GREF=$$ROOT^DILFD(FREF,"",1),TREF=$NA(^TMP("BQITAX",UID))
  1.  K @TREF
  1.  S TAX="BGP HIV TEST TAX" D BLD^BQITUTL(TAX,TREF)
  1.  S TIEN=0
  1.  F  S TIEN=$O(@TREF@(TIEN)) Q:'TIEN  D
  1.  . S IEN=""
  1.  . F  S IEN=$O(@GREF@("B",TIEN,IEN),-1) Q:IEN=""  D
  1.  .. I $G(@GREF@(IEN,0))="" Q
  1.  .. S DFN=$$GET1^DIQ(FREF,IEN,.02,"I") Q:DFN=""
  1.  .. I $D(@TGLOB@(DFN)) Q  ; Patient already identified
  1.  .. S VISIT=$$GET1^DIQ(FREF,IEN,.03,"I") Q:VISIT=""
  1.  .. I $$GET1^DIQ(9000010,VISIT,.11,"I")=1 Q
  1.  .. I FREF=9000010.07,PRIM,$P(@GREF@(IEN,0),U,12)'="P" S OPRM=0 D  Q:'OPRM
  1.  ... I $O(@GREF@("AD",VISIT,""))=IEN S OPRM=1
  1.  .. S VSDTM=$$GET1^DIQ(9000010,VISIT,.01,"I")\1 I VSDTM=0 Q
  1.  .. I $G(TMFRAME)'="",VSDTM<ENDT Q
  1.  .. ; If service categories, check the visit for the service category
  1.  .. S VSERV=$$GET1^DIQ(9000010,VISIT,.07,"I")
  1.  .. I $G(SERV)'="",SERV'[VSERV Q
  1.  .. S VSDTM=$$GET1^DIQ(9000010,VISIT,.01,"I")\1 Q:'VSDTM
  1.  .. I $G(TMFRAME)'="",VSDTM<ENDT Q
  1.  .. S RESULT=$$GET1^DIQ(FREF,IEN,.04,"E")
  1.  .. I $$POSITIVE^BKMVF32(RESULT) D STOR(DFN,"Positive HIV Screening",VISIT,IEN,TGLOB) Q
  1.  K @TREF
  1.  Q
  1.  ;
  1.  ;
  1. PAT(DEF,BTGLOB,BDFN) ;EP -- By patient
  1.  NEW DXOK ;,BQDXN,BQREF
  1.  NEW PRIM,SERV,VSERV,OPRM
  1.  S DXOK=0
  1.  ;
  1.  N TAX,FREF,GREF,TMFRAME,EXDT,DTDIF,ENDT,TRIEN,IEN,TDFN,VISIT
  1.  ;One diagnosis on Active Problem List (for PAT)
  1.  S TMFRAME="",EXDT="",DTDIF="",ENDT=""
  1.  S FREF=9000010.07,GREF=$$ROOT^DILFD(FREF,"",1),TREF=$NA(^TMP("BQITAX",UID))
  1.  K @TREF
  1.  S TAX="BGP HIV/AIDS DXS"
  1.  S PRIM=1,SERV="A;H"
  1.  S TPRGL=$NA(^TMP("TPRBLM",UID)) K @TPRGL
  1.  NEW TPGLOB
  1.  S TPGLOB=BTGLOB
  1.  D BLD^BQITUTL(TAX,TREF)
  1.  D PPRB^BQITDGN(BDFN,TPRGL)
  1.  I $D(@TPRGL@(BDFN))>0,'$D(@BTGLOB@(BDFN)) M @BTGLOB@(BDFN)=@TPRGL@(BDFN) Q 1
  1.  ;  For each entry in the taxonomy reference
  1.  ;S TRIEN=0
  1.  ;F  S TRIEN=$O(@TREF@(TRIEN)) Q:'TRIEN  D  I $D(@BTGLOB@(BDFN)) Q
  1.  ;. D PPRB^BQITDGN(BDFN,.BTGLOB)
  1.  ;I $D(@BTGLOB@(BDFN)) Q 1  ; Patient already identified
  1.  ;
  1.  ; At least 2 POVs ever at least 60 days apart (for PAT)
  1.  S TMREF=$NA(^TMP("BQITMPD",UID))
  1.  K @TMREF
  1.  N TIEN
  1.  S IEN=""
  1.  F  S IEN=$O(@GREF@("AC",BDFN,IEN),-1) Q:IEN=""  D
  1.  . S TIEN=$$GET1^DIQ(FREF,IEN,.01,"I") I TIEN="" Q
  1.  . I '$D(@TREF@(TIEN)) Q
  1.  . S VISIT=$$GET1^DIQ(FREF,IEN,.03,"I") I VISIT="" Q
  1.  . I $$GET1^DIQ(9000010,VISIT,.11,"I")=1 Q
  1.  . I FREF=9000010.07,PRIM,$P(@GREF@(IEN,0),U,12)'="P" S OPRM=0 D  Q:'OPRM
  1.  .. I $O(@GREF@("AD",VISIT,""))=IEN S OPRM=1
  1.  . S VSDTM=$$GET1^DIQ(9000010,VISIT,.01,"I")\1 I VSDTM=0 Q
  1.  . I $G(TMFRAME)'="",VSDTM<ENDT Q
  1.  . ; If service categories, check the visit for the service category
  1.  . S VSERV=$$GET1^DIQ(9000010,VISIT,.07,"I")
  1.  . I $G(SERV)'="",SERV'[VSERV Q
  1.  . I $D(@TMREF@(BDFN,VSDTM)) Q
  1.  . ;
  1.  . S @TMREF@(BDFN)=$G(@TMREF@(BDFN))+1
  1.  . S @TMREF@(BDFN,VSDTM,TIEN)="V"_U_VISIT_U_EXDT_U_IEN_U_FREF_U_TAX
  1.  ;
  1.  I $D(@TMREF@(BDFN)) D POV^BQITD081(BDFN,BTGLOB,TMREF,.DXOK)
  1.  K @TREF,@TMREF
  1.  I DXOK Q DXOK
  1.  ;
  1.  ; At least 2 CD4/Viral Load lab tests in the past two years
  1.  ; at least 60 days apart (for PAT)
  1.  N N
  1.  S TMREF=$NA(^TMP("BQITMPD",UID))
  1.  K @TMREF,BQITRY
  1.  S BQITRY(1)="BGP CD4 TAX^9000010.09^^T-24M"
  1.  S BQITRY(2)="BGP CD4 CPTS^9000010.18^^T-24M"
  1.  S BQITRY(3)="BGP CD4 LOINC CODES^9000010.09^^T-24M"
  1.  S BQITRY(4)="BGP HIV VIRAL LOAD TAX^9000010.09^^T-24M"
  1.  S BQITRY(5)="BGP HIV VIRAL LOAD CPTS^9000010.18^^T-24M"
  1.  S BQITRY(6)="BGP VIRAL LOAD LOINC CODES^9000010.09^^T-24M"
  1.  S N=0
  1.  F  S N=$O(BQITRY(N)) Q:'N  D
  1.  . K @TREF
  1.  . S TAX=$P(BQITRY(N),U,1),FREF=$P(BQITRY(N),U,2)
  1.  . S GREF=$$ROOT^DILFD(FREF,"",1),PLFLG=+$P(BQITRY(N),U,6)
  1.  . S TMFRAME=$P(BQITRY(N),U,4),ENDT=""
  1.  . D BLD^BQITUTL(TAX,TREF)
  1.  . S IEN=""
  1.  . F  S IEN=$O(@GREF@("AC",BDFN,IEN),-1) Q:IEN=""  D
  1.  .. S TIEN=$$GET1^DIQ(FREF,IEN,.01,"I") I TIEN="" Q
  1.  .. I '$D(@TREF@(TIEN)) Q
  1.  .. S VISIT=$$GET1^DIQ(FREF,IEN,.03,"I") I VISIT="" Q
  1.  .. I $$GET1^DIQ(9000010,VISIT,.11,"I")=1 Q
  1.  .. I FREF=9000010.07,PRIM,$P(@GREF@(IEN,0),U,12)'="P" S OPRM=0 D  Q:'OPRM
  1.  ... I $O(@GREF@("AD",VISIT,""))=IEN S OPRM=1
  1.  .. S VSDTM=$$GET1^DIQ(9000010,VISIT,.01,"I")\1 I VSDTM=0 Q
  1.  .. I $G(TMFRAME)'="",VSDTM<ENDT Q
  1.  .. ; If service categories, check the visit for the service category
  1.  .. S VSERV=$$GET1^DIQ(9000010,VISIT,.07,"I")
  1.  .. I $G(SERV)'="",SERV'[VSERV Q
  1.  .. I $D(@TMREF@(BDFN,VSDTM)) Q
  1.  .. ;
  1.  .. S @TMREF@(BDFN)=$G(@TMREF@(BDFN))+1
  1.  .. S @TMREF@(BDFN,VSDTM,TIEN)="V"_U_VISIT_U_EXDT_U_IEN_U_FREF_U_TAX
  1.  ;
  1.  I $D(@TMREF@(BDFN)) D CDVL^BQITD081(BDFN,BTGLOB,TMREF,.DXOK)
  1.  K @TREF,@TMREF
  1.  I DXOK Q DXOK
  1.  ;
  1.  ;Positive HIV Screening (for PAT)
  1.  S FREF=9000010.09,GREF=$$ROOT^DILFD(FREF,"",1),TREF=$NA(^TMP("BQITAX",UID))
  1.  S TAX="BGP HIV TEST TAX" D
  1.  . K @TREF
  1.  . D BLD^BQITUTL(TAX,TREF)
  1.  . S IEN=""
  1.  . F  S IEN=$O(@GREF@("AC",BDFN,IEN),-1) Q:IEN=""  D  Q:DXOK
  1.  .. S TIEN=$$GET1^DIQ(FREF,IEN,.01,"I") Q:TIEN=""
  1.  .. I '$D(@TREF@(TIEN)) Q
  1.  .. S VISIT=$$GET1^DIQ(FREF,IEN,.03,"I") Q:VISIT=""
  1.  .. I $$GET1^DIQ(9000010,VISIT,.11,"I")=1 Q
  1.  .. I FREF=9000010.07,PRIM,$P(@GREF@(IEN,0),U,12)'="P" S OPRM=0 D  Q:'OPRM
  1.  ... I $O(@GREF@("AD",VISIT,""))=IEN S OPRM=1
  1.  .. S VSDTM=$$GET1^DIQ(9000010,VISIT,.01,"I")\1 Q:'VSDTM
  1.  .. I $G(TMFRAME)'="",VSDTM<ENDT Q
  1.  .. ; If service categories, check the visit for the service category
  1.  .. S VSERV=$$GET1^DIQ(9000010,VISIT,.07,"I")
  1.  .. I $G(SERV)'="",SERV'[VSERV Q
  1.  .. S RESULT=$$GET1^DIQ(FREF,IEN,.04,"E")
  1.  .. I $$POSITIVE^BKMVF32(RESULT) D
  1.  ... D STOR(BDFN,"Positive HIV Screening",VISIT,IEN,BTGLOB)
  1.  ... S DXOK=1
  1.  Q DXOK
  1.  ;
  1. STOR(SDFN,CRIT,VIENS,IENS,GLOB) ;  Store the patient's met criteria
  1.  NEW VST,I,VSDTM,IIEN
  1.  I $G(@GLOB@(SDFN))>3 Q
  1.  I $D(@GLOB@(SDFN,"CRITERIA",CRIT))>0 Q
  1.  S @GLOB@(SDFN)=$G(@GLOB@(SDFN))+1
  1.  S @GLOB@(SDFN,"CRITERIA",CRIT)=""
  1.  I $G(VIENS)["," D  Q
  1.  . F I=1:1 S VST=$P(VIENS,",",I) Q:VST=""  D
  1.  .. S IIEN=$P(IENS,",",I)
  1.  .. S VSDTM=$$GET1^DIQ(9000010,VST_",",.01,"I") Q:'VSDTM
  1.  .. I DTDIF'="" S EXDT=$$FMADD^XLFDT(VSDTM,DTDIF)
  1.  .. S @GLOB@(SDFN,"CRITERIA",CRIT,"V",VST,IIEN)=VSDTM_U_U_IIEN_U_FREF
  1.  .. I EXDT'="" S $P(@GLOB@(SDFN,"CRITERIA",CRIT,"V",VST,IIEN),U,2)=EXDT
  1.  I $G(VIENS)'="" D
  1.  . S VSDTM=$$GET1^DIQ(9000010,VIENS_",",.01,"I") Q:'VSDTM
  1.  . I DTDIF'="" S EXDT=$$FMADD^XLFDT(VSDTM,DTDIF)
  1.  . S @GLOB@(SDFN,"CRITERIA",CRIT,"V",VIENS,IENS)=VSDTM_U_U_IENS_U_FREF
  1.  . I EXDT'="" S $P(@GLOB@(SDFN,"CRITERIA",CRIT,"V",VIENS,IENS),U,2)=EXDT
  1.  Q
  1.  ;
  1. GETVST ; EP - Get visit related data
  1.  S TIEN="",PRIM=1
  1.  F  S TIEN=$O(@TREF@(TIEN)) Q:TIEN=""  D
  1.  . S IEN=""
  1.  . F  S IEN=$O(@GREF@("B",TIEN,IEN),-1) Q:IEN=""  D
  1.  .. S TDFN=$$GET1^DIQ(FREF,IEN,.02,"I") I TDFN="" Q
  1.  .. I $D(@TGLOB@(TDFN)) Q
  1.  .. S VISIT=$$GET1^DIQ(FREF,IEN,.03,"I") I VISIT="" Q
  1.  .. I $$GET1^DIQ(9000010,VISIT,.11,"I")=1 Q
  1.  .. I FREF=9000010.07,PRIM,$P(@GREF@(IEN,0),U,12)'="P" S OPRM=0 D  Q:'OPRM
  1.  ... I $O(@GREF@("AD",VISIT,""))=IEN S OPRM=1
  1.  .. S VSDTM=$$GET1^DIQ(9000010,VISIT,.01,"I")\1 I VSDTM=0 Q
  1.  .. I $G(TMFRAME)'="",VSDTM<ENDT Q
  1.  .. ; If service categories, check the visit for the service category
  1.  .. S VSERV=$$GET1^DIQ(9000010,VISIT,.07,"I")
  1.  .. I $G(SERV)'="",SERV'[VSERV Q
  1.  .. ;
  1.  .. I $D(@TMREF@(TDFN,VSDTM)) Q
  1.  .. S @TMREF@(TDFN)=$G(@TMREF@(TDFN))+1
  1.  .. S @TMREF@(TDFN,VSDTM,TIEN)="V"_U_VISIT_U_EXDT_U_IEN_U_FREF_U_TAX
  1.  Q