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

BKMQQCRU.m

Go to the documentation of this file. 
  1. BKMQQCRU ;VNGT/HS/ALA-QOC Utility Program ; 22 Mar 2010  9:28 AM
  1.  ;;2.1;HIV MANAGEMENT SYSTEM;;Feb 07, 2011
  1.  ;
  1. ACTWRK ; Active from HMS Register Search
  1.  N ENDDT,GLOBX,REGDFN,VSTDT,HIVDT,AIDDT
  1.  N EXEC,IENS,BKMPATN,OK,DXCAT,STAT
  1.  N TREF,TAX,TRIEN,DXOK,TIEN,IEN,VISIT,VSDTM
  1.  ;
  1.  S ENDDT=$$FMADD^XLFDT(EDATE,-183)
  1.  S GLOBX=$NA(^TMP("BKMQQCRX",UID))
  1.  K @GLOBX
  1.  ;
  1.  ; Denominator:
  1.  ;     Patients with Proposed or Accepted tag status
  1.  ;     with an HMS register status of active or blank (not in register)
  1.  ;S TREF=$NA(^TMP("BQITAX",UID)) K @TREF
  1.  S TREF="BQITAX"
  1.  S TAX="BGP HIV/AIDS DXS"
  1.  D BLD^BQITUTL(TAX,TREF)
  1.  ;
  1.  S REGDFN=0
  1.  F  S REGDFN=$O(@GLOB@("HIVCHK",REGDFN)) Q:REGDFN=""  D
  1.  . ;
  1.  . S IENS=$$HMSIENS^BKMQUTL(REGDFN)
  1.  . ;
  1.  . ; Selected active HMS Register patients
  1.  . I $G(BKMRPOP)="R" S OK=1 D  Q:'OK
  1.  .. I IENS="" S OK=0 Q
  1.  .. S STAT=$$GET1^DIQ(90451.01,IENS,.5,"I") I STAT'="A",STAT'="T" S OK=0 Q
  1.  .. S DXCAT=$$GET1^DIQ(90451.01,IENS,2.3,"I")
  1.  .. ; Diagnosis category of "A", "H" or blank (At Risk is excluded)
  1.  .. I DXCAT="A"!(DXCAT="H")!(DXCAT="") Q
  1.  .. ;I "AH"[DXCAT Q
  1.  .. S OK=0 Q
  1.  . ;
  1.  . ; Selected active HIV/AIDS tag option.
  1.  . ; Check if current status matches selected status.
  1.  . I $G(BKMRPOP)="D",'$$ACT^BKMQUTL(REGDFN,HMSIEN,BKMTAG) Q
  1.  . ;
  1.  . ; Exclude if initial diagnosis was within 6 months of end date
  1.  . ; find latest date of fields 5 and 5.5
  1.  . S VSTDT=""
  1.  . S HIVDT=$$GET1^DIQ(90451.01,IENS,5.5,"I")
  1.  . I HIVDT'="",HIVDT<VSTDT!(VSTDT="") S VSTDT=HIVDT
  1.  . S AIDDT=$$GET1^DIQ(90451.01,IENS,5,"I")
  1.  . I AIDDT'="",AIDDT<VSTDT!(VSTDT="") S VSTDT=AIDDT
  1.  . ;
  1.  . ; If initial HIV or AIDS dx date check fails look for HIV/AIDS POV or Active Problem List
  1.  . I VSTDT>ENDDT!(VSTDT="") S DXOK=0 D  I 'DXOK S BKMPATN=$$GET1^DIQ(2,REGDFN,".01","E"),NDA(BKMPATN,REGDFN)="",NDA=$G(NDA)+1 Q
  1.  .. ;
  1.  .. ; At least 1 HIV/AIDS POV or active problem list 6 months or more prior to report end date
  1.  .. ;
  1.  .. S TRIEN=0,DXOK=0
  1.  .. F  S TRIEN=$O(@TREF@(TRIEN)) Q:'TRIEN  I $$PRB(REGDFN,ENDDT) S DXOK=1 Q
  1.  .. Q:DXOK
  1.  .. ;
  1.  .. N TIEN,VDATA,PDATA
  1.  .. S IEN=""
  1.  .. F  S IEN=$O(^AUPNVPOV("AC",REGDFN,IEN),-1) Q:IEN=""  D  Q:DXOK
  1.  ... S PDATA=$G(^AUPNVPOV(IEN,0)) I PDATA="" Q
  1.  ... ;S TIEN=$$GET1^DIQ(9000010.07,IEN,.01,"I") I TIEN="" Q
  1.  ... S TIEN=$P(PDATA,U,1) I TIEN="" Q
  1.  ... I '$D(@TREF@(TIEN)) Q
  1.  ... S VISIT=$P(PDATA,U,3) I VISIT="" Q
  1.  ... S VDATA=$G(^AUPNVSIT(VISIT,0)) I VDATA="" Q
  1.  ... ;S VISIT=$$GET1^DIQ(9000010.07,IEN,.03,"I") I VISIT="" Q
  1.  ... I $P(VDATA,U,11)=1 Q
  1.  ... ;I $$GET1^DIQ(9000010,VISIT,.11,"I")=1 Q
  1.  ... S VSDTM=$P(VDATA,U,1)\1 I VSDTM=0 Q
  1.  ... ;S VSDTM=$$GET1^DIQ(9000010,VISIT,.01,"I")\1 I VSDTM=0 Q
  1.  ... I VSDTM<ENDDT S DXOK=1 Q
  1.  . S @GLOBX@("HIVCHK",REGDFN)=""
  1.  K @GLOB@("HIVCHK")
  1.  M @GLOB@("HIVCHK")=@GLOBX@("HIVCHK")
  1.  K @GLOBX@("HIVCHK"),@TREF
  1.  Q
  1.  ;
  1. PRB(DFN,DATE) ;EP - Check Problem File for instance of a patient
  1.  NEW PROB,PVIEN,VSDTM,OK,PBDATA
  1.  S PROB=0,OK=0
  1.  S PVIEN=""
  1.  F  S PVIEN=$O(^AUPNPROB("AC",DFN,PVIEN),-1) Q:'PVIEN  D  Q:OK
  1.  . S PBDATA=$G(^AUPNPROB(PVIEN,0)) I PBDATA="" Q
  1.  . S TIEN=$P(PBDATA,U,1) I TIEN="" Q
  1.  . ;S TIEN=$$GET1^DIQ(9000011,PVIEN,.01,"I") I TIEN="" Q
  1.  . I '$D(@TREF@(TIEN)) Q
  1.  . ;  Check class - if Family ignore
  1.  . I $P(PBDATA,U,4)="F" Q
  1.  . I $P(PBDATA,U,12)'="A" Q
  1.  . ;I $$GET1^DIQ(9000011,PVIEN,.04,"I")="F" Q
  1.  . ;I $$GET1^DIQ(9000011,PVIEN,.12,"I")'="A" Q
  1.  . S VSDTM=$$PROB^BQIUL1(PVIEN)\1 I VSDTM=0 Q
  1.  . I VSDTM<DATE S OK=1 Q
  1.  Q OK
  1.  ;
  1. ASTAT(BKMDFN,RPTDT,STAT,REG) ;EP -- ARV Status and Regimen
  1.  ; Input
  1.  ;   BKMDFN - Patient IEN
  1.  ;   RPTDT  - Report Date
  1.  ;   STAT   - ARV Status
  1.  ;   REG    - ARV Regimen
  1.  ; Description
  1.  ;   Returns a result if the patient has the ARV status in the Report Period
  1.  NEW QFL,STDT,IEN,RESULT,BKMIEN,BKMREG,REVPER
  1.  S REVPER=$$FMADD^XLFDT(RPTDT,-365),STAT=$G(STAT,""),REG=$G(REG,"")
  1.  S STDT=RPTDT+.005
  1.  S BKMIEN=$$BKMIEN^BKMIXX3(BKMDFN) I BKMIEN="" Q 0
  1.  S BKMREG=$$BKMREG^BKMIXX3(BKMIEN)
  1.  S RESULT=0,QFL=0
  1.  F  S STDT=$O(^BKM(90451,BKMIEN,1,BKMREG,45,"B",STDT),-1) Q:STDT=""!(STDT<REVPER)  D  Q:QFL
  1.  . S IEN=""
  1.  . F  S IEN=$O(^BKM(90451,BKMIEN,1,BKMREG,45,"B",STDT,IEN),-1) Q:IEN=""  D  Q:QFL
  1.  .. I $G(STAT)'="",$P(^BKM(90451,BKMIEN,1,BKMREG,45,IEN,0),U,2)'=STAT Q
  1.  .. I $G(REG)'="",$P(^BKM(90451,BKMIEN,1,BKMREG,45,IEN,0),U,3)'=REG Q
  1.  .. S RESULT=1_U_STDT_U_STAT_U_REG,QFL=1
  1.  Q RESULT
  1.  ;
  1. LAB(BKMDFN,SDATE,ALL) ;
  1.  K ALL
  1.  ;S ENDATE=$$FMADD^XLFDT(SDATE,-56)
  1.  S ENDATE=SDATE
  1.  S BEGDATE=$$FMADD^XLFDT(SDATE,56)
  1.  S HREV=$$FMTH^XLFDT(BEGDATE,1),HEND=$$FMTH^XLFDT(ENDATE,1)
  1.  S TREF=$NA(^TMP("BQITAX",UID)) K @TREF
  1.  S CD4="BKMCD4" K @CD4
  1.  F TAX="BKM CD4 ABS TESTS TAX","BKMV CD4 ABS LOINC CODES"  D BLD^BQITUTL(TAX,CD4)
  1.  M @TREF=@CD4
  1.  ;
  1.  S VIRAL="BKMVIR" K @VIRAL
  1.  F TAX="BGP HIV VIRAL LOAD TAX","BGP VIRAL LOAD LOINC CODES" D BLD^BQITUTL(TAX,VIRAL)
  1.  M @TREF=@VIRAL
  1.  ;
  1.  S IEN=""
  1.  F  S IEN=$O(^AUPNVLAB("AC",BKMDFN,IEN),-1) Q:IEN=""  D
  1.  . S PDATA=$G(^AUPNVLAB(IEN,0)) I PDATA="" Q
  1.  . S TIEN=$P(PDATA,U,1) I TIEN="" Q
  1.  . I '$D(@TREF@(TIEN)) Q
  1.  . S VISIT=$P(PDATA,U,3) I VISIT="" Q
  1.  . S VDATA=$G(^AUPNVSIT(VISIT,0)) I VDATA="" Q
  1.  . I $P(VDATA,U,11)=1 Q
  1.  . S VSDTM=$P(VDATA,U,1)\1 I VSDTM=0 Q
  1.  . ; Get collection date/time
  1.  . S COLDTM=$P($G(^AUPNVLAB(IEN,12)),U,1)\1
  1.  . I COLDTM'=0 S VSDTM=COLDTM
  1.  . S RESULT=$P(PDATA,U,4)
  1.  . S HSDTM=$$FMTH^XLFDT(VSDTM,1)
  1.  . I HSDTM>HREV!(HSDTM<HEND) Q
  1.  . I $D(@CD4@(TIEN)) S ALL("ZLAB","CD4",VSDTM,IEN)=RESULT
  1.  . I $D(@VIRAL@(TIEN)) S ALL("ZLAB","VIRAL",VSDTM,IEN)=RESULT
  1.  Q
  1.  ;
  1. LB(ALL) ;
  1.  NEW COLDTM
  1.  I $G(UID)="" S UID=$J
  1.  S REVPER=$$FMADD^XLFDT(RPTDT,-365)
  1.  S P1B=$$FMADD^XLFDT(RPTDT,-120),P1E=RPTDT
  1.  S P2B=$$FMADD^XLFDT(RPTDT,-121),P2E=$$FMADD^XLFDT(RPTDT,-240)
  1.  S P3B=$$FMADD^XLFDT(RPTDT,-241),P3E=REVPER
  1.  S TREF=$NA(^TMP("BQITAX",UID)) K @TREF
  1.  S CD4="BKMCD4" K @CD4
  1.  F TAX="BKM CD4 ABS TESTS TAX","BKMV CD4 ABS LOINC CODES"  D BLD^BQITUTL(TAX,CD4)
  1.  S TIEN=""
  1.  F  S TIEN=$O(@CD4@(TIEN)) Q:TIEN=""  D
  1.  . S IEN=""
  1.  . F  S IEN=$O(^AUPNVLAB("B",TIEN,IEN)) Q:IEN=""  D
  1.  .. S DFN=$P($G(^AUPNVLAB(IEN,0)),U,2) I DFN="" Q
  1.  .. S VISIT=$P($G(^AUPNVLAB(IEN,0)),U,3) I VISIT="" Q
  1.  .. S VSDTM=$P($G(^AUPNVSIT(VISIT,0)),U,1)\1 I +VSDTM=0 Q
  1.  .. S COLDTM=$P($G(^AUPNVLAB(IEN,12)),U,1)\1
  1.  .. I COLDTM'=0 S VSDTM=COLDTM
  1.  .. S RESULT=$P(^AUPNVLAB(IEN,0),U,4) I RESULT="" Q
  1.  .. I RESULT?.AP Q
  1.  .. I VSDTM<REVPER!(VSDTM>RPTDT) Q
  1.  .. ;S ALL("ZLAB","CD4",DFN,VSDTM,IEN)=RESULT
  1.  .. I VSDTM'<P1B,VSDTM'>P1E S ALL("CD4",DFN,VSDTM,IEN)=RESULT_U_"P1"
  1.  .. I VSDTM'>P2B,VSDTM'<P2E S ALL("CD4",DFN,VSDTM,IEN)=RESULT_U_"P2"
  1.  .. I VSDTM'>P3B,VSDTM'<P3E S ALL("CD4",DFN,VSDTM,IEN)=RESULT_U_"P3"
  1.  K @CD4
  1.  ;
  1.  S VIRAL="BKMVIR" K @VIRAL
  1.  F TAX="BGP HIV VIRAL LOAD TAX","BGP VIRAL LOAD LOINC CODES" D BLD^BQITUTL(TAX,VIRAL)
  1.  S TIEN=""
  1.  F  S TIEN=$O(@VIRAL@(TIEN)) Q:TIEN=""  D
  1.  . S IEN=""
  1.  . F  S IEN=$O(^AUPNVLAB("B",TIEN,IEN)) Q:IEN=""  D
  1.  .. S DFN=$P($G(^AUPNVLAB(IEN,0)),U,2) I DFN="" Q
  1.  .. S VISIT=$P($G(^AUPNVLAB(IEN,0)),U,3) I VISIT="" Q
  1.  .. S VSDTM=$P($G(^AUPNVSIT(VISIT,0)),U,1)\1 I +VSDTM=0 Q
  1.  .. S COLDTM=$P($G(^AUPNVLAB(IEN,12)),U,1)\1
  1.  .. I COLDTM'=0 S VSDTM=COLDTM
  1.  .. S RESULT=$P(^AUPNVLAB(IEN,0),U,4) I RESULT="" Q
  1.  .. I RESULT?.AP Q
  1.  .. I VSDTM<REVPER!(VSDTM>RPTDT) Q
  1.  .. ;S ALL("ZLAB","VIRAL",DFN,VSDTM,IEN)=RESULT
  1.  .. I VSDTM'<P1B,VSDTM'>P1E S ALL("VIRAL",DFN,VSDTM,IEN)=RESULT_U_"P1"
  1.  .. I VSDTM'>P2B,VSDTM'<P2E S ALL("VIRAL",DFN,VSDTM,IEN)=RESULT_U_"P2"
  1.  .. I VSDTM'>P3B,VSDTM'<P3E S ALL("VIRAL",DFN,VSDTM,IEN)=RESULT_U_"P3"
  1.  K @VIRAL
  1.  Q
  1.  ;
  1. DTR(RPTDT) ;EP - Get all date ranges from a report end date
  1.  S REVPER=$$FMADD^XLFDT(RPTDT,-365)
  1.  ;S P1B=$$FMADD^XLFDT(RPTDT,-120),P1E=RPTDT
  1.  S P1B=RPTDT,P1E=$$FMADD^XLFDT(RPTDT,-120)
  1.  S HP1B=$$FMTH^XLFDT(P1B,1),HP1E=$$FMTH^XLFDT(P1E,1)
  1.  S P2B=$$FMADD^XLFDT(RPTDT,-121),P2E=$$FMADD^XLFDT(RPTDT,-240)
  1.  S HP2B=$$FMTH^XLFDT(P2B,1),HP2E=$$FMTH^XLFDT(P2E,1)
  1.  S P3B=$$FMADD^XLFDT(RPTDT,-241),P3E=REVPER
  1.  S HP3B=$$FMTH^XLFDT(P3B,1),HP3E=$$FMTH^XLFDT(P3E,1)
  1.  ;S P61B=$$FMADD^XLFDT(RPTDT,-181),P61E=RPTDT
  1.  S P61B=RPTDT,P61E=$$FMADD^XLFDT(RPTDT,-181)
  1.  S HP61B=$$FMTH^XLFDT(P61B,1),HP61E=$$FMTH^XLFDT(P61E,1)
  1.  S P62B=$$FMADD^XLFDT(RPTDT,-182),P62E=REVPER
  1.  S HP62B=$$FMTH^XLFDT(P62B,1),HP62E=$$FMTH^XLFDT(P62E,1)
  1.  Q