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

BQITD13.m

Go to the documentation of this file. 
  1. BQITD13 ;VNGT/HS/ALA-Pregnancy ; 15 Jun 2011  9:13 AM
  1.  ;;2.4;ICARE MANAGEMENT SYSTEM;;Apr 01, 2015;Build 41
  1.  ;
  1.  ;
  1. POP(BQARY,TGLOB) ; EP
  1.  ;
  1.  ;Description
  1.  ;  Finds all patients who meet the criteria for currently pregnant
  1.  ;Input
  1.  ;  BQARY - Array of taxonomies and other information
  1.  ;  TGLOB - Global where data is to be stored
  1.  ;          Structure:
  1.  ;          TGLOB(DFN,"CRITERIA",criteria or taxonomy,visit or problem ien)=date/time
  1.  ;
  1.  NEW BQFLG,BQTIME,BQTM
  1.  S BQFLG=$P($G(^BQI(90508,1,16)),U,1),BQTIME=$P($G(^BQI(90508,1,16)),U,2)
  1.  ; ILI Algorithm
  1.  I BQFLG="L" D
  1.  . NEW BQDFN
  1.  . S BQDFN=0
  1.  . F  S BQDFN=$O(^DPT(BQDFN)) Q:'BQDFN  D
  1.  .. I $$PNM^APCLSIL1(BQDFN,DT)="Y" S @TGLOB@(BQDFN)=""
  1.  ;
  1.  ; iCare Algorithm
  1.  I BQFLG="I" D
  1.  . NEW REVPER,TREF,NREF,TAX,EDATE,TMGL,BDFN,BDTM,VIS,IEN,DXN
  1.  . S BQTM=(BQTIME*30.4167)
  1.  . S EDATE=DT
  1.  . S REVPER=$$FMADD^XLFDT(EDATE,-(BQTM))
  1.  . S TREF=$NA(^TMP("BQITAX",UID)) K @TREF
  1.  . F TAX="BQI PREGNANCY DXS" D BLD^BQITUTL(TAX,TREF)
  1.  . S TMGL=$NA(^TMP("BQIPREG",UID)) K @TMGL
  1.  . D POV(.TMGL,TREF,REVPER,"")
  1.  . ;
  1.  . ; Exceptions
  1.  . S NREF="ARRAY" K @NREF
  1.  . F TAX="BGP MISCARRIAGE/ABORTION DXS","SURVEILLANCE H1N1 DELIVERY DX" D BLD^BQITUTL(TAX,NREF)
  1.  . D EPOV(.TMGL,.NREF,REVPER,"")
  1.  . K @NREF,@TREF
  1.  . ; Procedures
  1.  . S NREF="ARRAY" K @NREF
  1.  . F TAX="BGP ABORTION PROCEDURES","BQI DELIVERY PROCEDURES" D BLD^BQITUTL(TAX,NREF)
  1.  . D EPRC(.TMGL,.NREF,REVPER,"")
  1.  . ; CPTs
  1.  . S TREF="BQITAX" K @TREF
  1.  . F TAX="BGP CPT ABORTION","BGP CPT MISCARRIAGE","SURVEILLANCE H1N1 DELIVERY CPT" D BLD^BQITUTL(TAX,TREF)
  1.  . D ECPT(.TMGL,.TREF,REVPER,"")
  1.  . K @TREF
  1.  . ;
  1.  . S BDFN=""
  1.  . F  S BDFN=$O(@TMGL@(BDFN)) Q:BDFN=""  D PARS(BDFN,TGLOB)
  1.  Q
  1.  ;
  1. POV(GLB,TREF,REVPER,BQDFN) ;EP
  1.  NEW TIEN,VDATA,PDATA,VISIT,VSDTM,IEN,DFN,BGDT,ENDT
  1.  I $G(BQDFN)="" D
  1.  . S TIEN=""
  1.  . F  S TIEN=$O(@TREF@(TIEN)) Q:TIEN=""  D
  1.  .. S IEN=""
  1.  .. F  S IEN=$O(^AUPNVPOV("B",TIEN,IEN),-1) Q:IEN=""  D
  1.  ... S PDATA=$G(^AUPNVPOV(IEN,0)) I PDATA="" 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.  ... Q:"AORSHI"'[$P(VDATA,U,7)
  1.  ... S VSDTM=$P(VDATA,U,1)\1 I VSDTM=0 Q
  1.  ... I VSDTM<REVPER!(VSDTM>EDATE) Q
  1.  ... S TYP=@TREF@(TIEN),DFN=$P(VDATA,U,5)
  1.  ... S @GLB@(DFN,VSDTM,VISIT,IEN)=TYP_U_TAX
  1.  ;
  1.  I $G(BQDFN)'="" D
  1.  . S BGDT=(9999999-DT)-1,ENDT=9999999-REVPER
  1.  . F  S BGDT=$O(^AUPNVPOV("AA",BQDFN,BGDT)) Q:BGDT=""!(BGDT>ENDT)  D
  1.  .. S IEN=""
  1.  .. F  S IEN=$O(^AUPNVPOV("AA",BQDFN,BGDT,IEN)) Q:IEN=""  D
  1.  ... S PDATA=$G(^AUPNVPOV(IEN,0)) I PDATA="" Q
  1.  ... S TIEN=$P(PDATA,U,1)
  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.  ... Q:"AORSHI"'[$P(VDATA,U,7)
  1.  ... S VSDTM=$P(VDATA,U,1)\1 I VSDTM=0 Q
  1.  ... S TYP=@TREF@(TIEN),DFN=$P(VDATA,U,5)
  1.  ... S @GLB@(DFN,VSDTM,VISIT,IEN)=TYP_U_TAX
  1.  Q
  1.  ;
  1. EPOV(GLB,TREF,REVPER,BQDFN) ;EP
  1.  NEW TIEN,VDATA,PDATA,VISIT,VSDTM,IEN,DFN
  1.  I $G(BQDFN)="" D
  1.  . S TIEN=""
  1.  . F  S TIEN=$O(@TREF@(TIEN)) Q:TIEN=""  D
  1.  .. S IEN=""
  1.  .. F  S IEN=$O(^AUPNVPOV("B",TIEN,IEN),-1) Q:IEN=""  D
  1.  ... S PDATA=$G(^AUPNVPOV(IEN,0)) I PDATA="" 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.  ... Q:"AORSHI"'[$P(VDATA,U,7)
  1.  ... S VSDTM=$P(VDATA,U,1)\1 I VSDTM=0 Q
  1.  ... I VSDTM<REVPER!(VSDTM>EDATE) Q
  1.  ... S DFN=$P(VDATA,U,5)
  1.  ... I $D(@GLB@(DFN)) D
  1.  .... NEW PDTM
  1.  .... S PDTM="" F  S PDTM=$O(@GLB@(DFN,PDTM)) Q:PDTM=""  D
  1.  ..... I PDTM<VSDTM K @GLB@(DFN,PDTM)
  1.  ;
  1.  I $G(BQDFN)'="" D
  1.  . S BGDT=(9999999-DT)-1,ENDT=9999999-REVPER
  1.  . F  S BGDT=$O(^AUPNVPOV("AA",BQDFN,BGDT)) Q:BGDT=""!(BGDT>ENDT)  D
  1.  .. S IEN=""
  1.  .. F  S IEN=$O(^AUPNVPOV("AA",BQDFN,BGDT,IEN)) Q:IEN=""  D
  1.  ... S PDATA=$G(^AUPNVPOV(IEN,0)) I PDATA="" Q
  1.  ... S TIEN=$P(PDATA,U,1)
  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.  ... Q:"AORSHI"'[$P(VDATA,U,7)
  1.  ... S DFN=$P(VDATA,U,5),VSDTM=$P(VDATA,U,1)\1
  1.  ... I $D(@GLB@(DFN)) D
  1.  .... NEW PDTM
  1.  .... S PDTM="" F  S PDTM=$O(@GLB@(DFN,PDTM)) Q:PDTM=""  D
  1.  ..... I PDTM<VSDTM K @GLB@(DFN,PDTM)
  1.  Q
  1.  ;
  1. ECPT(GLB,TREF,REVPER,BQDFN) ;
  1.  NEW TIEN,VDATA,PDATA,VISIT,VSDTM,DFN
  1.  I $G(BQDFN)="" D
  1.  . S TIEN=""
  1.  . F  S TIEN=$O(@TREF@(TIEN)) Q:TIEN=""  D
  1.  .. S IEN=""
  1.  .. F  S IEN=$O(^AUPNVCPT("B",TIEN,IEN),-1) Q:IEN=""  D
  1.  ... S PDATA=$G(^AUPNVCPT(IEN,0)) I PDATA="" 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.  ... Q:"AORSHI"'[$P(VDATA,U,7)
  1.  ... S VSDTM=$P(VDATA,U,1)\1 I VSDTM=0 Q
  1.  ... I VSDTM<REVPER!(VSDTM>EDATE) Q
  1.  ... S DFN=$P(VDATA,U,5)
  1.  ... I $D(@GLB@(DFN)) D
  1.  .... NEW PDTM
  1.  .... S PDTM="" F  S PDTM=$O(@GLB@(DFN,PDTM)) Q:PDTM=""  D
  1.  ..... I PDTM<VSDTM K @GLB@(DFN,PDTM)
  1.  ;
  1.  I $G(BQDFN)'="" D
  1.  . S BGDT=(9999999-DT)-1,ENDT=9999999-REVPER
  1.  . S TIEN=""
  1.  . F  S TIEN=$O(@TREF@(TIEN)) Q:TIEN=""  D
  1.  .. F  S BGDT=$O(^AUPNVCPT("AA",BQDFN,TIEN,BGDT)) Q:BGDT=""!(BGDT>ENDT)  D
  1.  ... S IEN=""
  1.  ... F  S IEN=$O(^AUPNVCPT("AA",BQDFN,TIEN,BGDT,IEN)) Q:IEN=""  D
  1.  .... S PDATA=$G(^AUPNVCPT(IEN,0)) I PDATA="" 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.  .... Q:"AORSHI"'[$P(VDATA,U,7)
  1.  .... S DFN=$P(VDATA,U,5),VSDTM=$P(VDATA,U,1)\1
  1.  .... I $D(@GLB@(DFN)) D
  1.  ..... NEW PDTM
  1.  ..... S PDTM="" F  S PDTM=$O(@GLB@(DFN,PDTM)) Q:PDTM=""  D
  1.  ...... I PDTM<VSDTM K @GLB@(DFN,PDTM)
  1.  Q
  1.  ;
  1. EPRC(GLB,TREF,REVPER,BQDFN) ;EP
  1.  NEW TIEN,VDATA,PDATA,VISIT,VSDTM,IEN,DFN
  1.  I $G(BQDFN)="" D
  1.  . S TIEN=""
  1.  . F  S TIEN=$O(@TREF@(TIEN)) Q:TIEN=""  D
  1.  .. S IEN=""
  1.  .. F  S IEN=$O(^AUPNVPRC("B",TIEN,IEN),-1) Q:IEN=""  D
  1.  ... S PDATA=$G(^AUPNVPRC(IEN,0)) I PDATA="" 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.  ... Q:"AORSHI"'[$P(VDATA,U,7)
  1.  ... S VSDTM=$P(VDATA,U,1)\1 I VSDTM=0 Q
  1.  ... I VSDTM<REVPER!(VSDTM>EDATE) Q
  1.  ... S DFN=$P(VDATA,U,5)
  1.  ... I $D(@GLB@(DFN)) D
  1.  .... NEW PDTM
  1.  .... S PDTM="" F  S PDTM=$O(@GLB@(DFN,PDTM)) Q:PDTM=""  D
  1.  ..... I PDTM<VSDTM K @GLB@(DFN,PDTM)
  1.  ;
  1.  I $G(BQDFN)'="" D
  1.  . S BGDT=(9999999-DT)-1,ENDT=9999999-REVPER
  1.  . F  S BGDT=$O(^AUPNVPRC("AA",BQDFN,BGDT)) Q:BGDT=""!(BGDT>ENDT)  D
  1.  .. S IEN=""
  1.  .. F  S IEN=$O(^AUPNVPRC("AA",BQDFN,BGDT,IEN)) Q:IEN=""  D
  1.  ... S PDATA=$G(^AUPNVPRC(IEN,0)) I PDATA="" Q
  1.  ... S TIEN=$P(PDATA,U,1)
  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.  ... Q:"AORSHI"'[$P(VDATA,U,7)
  1.  ... S DFN=$P(VDATA,U,5),VSDTM=$P(VDATA,U,1)\1
  1.  ... I $D(@GLB@(DFN)) D
  1.  .... NEW PDTM
  1.  .... S PDTM="" F  S PDTM=$O(@GLB@(DFN,PDTM)) Q:PDTM=""  D
  1.  ..... I PDTM<VSDTM K @GLB@(DFN,PDTM)
  1.  Q
  1.  ;
  1. PAT(DEF,BTGLOB,BDFN) ;EP -- Get value for a single patient
  1.  NEW DXOK,BQDXN,BQREF,BQFLG,BQTIME,BQTM,EDATE,REVPER,TREF,TAX,TMGL,NREF
  1.  S BQFLG=$P($G(^BQI(90508,1,16)),U,1),BQTIME=$P($G(^BQI(90508,1,16)),U,2)
  1.  S DXOK=0
  1.  ; ILI Algorithm
  1.  I BQFLG="L" D
  1.  . I $$PNM^APCLSIL1(BDFN,DT)="Y" S DXOK=1
  1.  ;
  1.  ; iCare Algorithm
  1.  I BQFLG="I" D
  1.  . S BQTM=(BQTIME*30.4167)
  1.  . S EDATE=DT
  1.  . S REVPER=$$FMADD^XLFDT(EDATE,-(BQTM))
  1.  . S TREF=$NA(^TMP("BQITAX",UID)) K @TREF
  1.  . F TAX="BQI PREGNANCY DXS" D BLD^BQITUTL(TAX,TREF)
  1.  . S TMGL=$NA(^TMP("BQIPREG",UID)) K @TMGL
  1.  . D POV(.TMGL,TREF,REVPER,BDFN)
  1.  . ;
  1.  . ; Exceptions
  1.  . S NREF="ARRAY" K @NREF
  1.  . F TAX="BGP MISCARRIAGE/ABORTION DXS","SURVEILLANCE H1N1 DELIVERY DX" D BLD^BQITUTL(TAX,NREF)
  1.  . D EPOV(.TMGL,.NREF,REVPER,BDFN)
  1.  . K @NREF,@TREF
  1.  . ; Procedures
  1.  . S NREF="ARRAY" K @NREF
  1.  . F TAX="BGP ABORTION PROCEDURES","BQI DELIVERY PROCEDURES" D BLD^BQITUTL(TAX,NREF)
  1.  . D EPRC(.TMGL,.NREF,REVPER,BDFN)
  1.  . ; CPTs
  1.  . S TREF="BQITAX" K @TREF
  1.  . F TAX="BGP CPT ABORTION","BGP CPT MISCARRIAGE","SURVEILLANCE H1N1 DELIVERY CPT" D BLD^BQITUTL(TAX,TREF)
  1.  . D ECPT(.TMGL,.TREF,REVPER,BDFN)
  1.  . K @TREF
  1.  . ;
  1.  . I $D(@TMGL@(BDFN)) S DXOK=1 D PARS(BDFN,BTGLOB)
  1.  Q DXOK
  1.  ;
  1. PARS(BQDFN,GLOB) ;EP
  1.  NEW BDTM,VIS,IEN,DXN
  1.  S BDTM="" F  S BDTM=$O(@TMGL@(BQDFN,BDTM)) Q:BDTM=""  D
  1.  . S VIS="" F  S VIS=$O(@TMGL@(BQDFN,BDTM,VIS)) Q:VIS=""  D
  1.  .. S IEN="" F  S IEN=$O(@TMGL@(BQDFN,BDTM,VIS,IEN)) Q:IEN=""  D
  1.  ... S DXN=@TMGL@(BQDFN,BDTM,VIS,IEN)
  1.  ... I $P(DXN,U,5)'="" S DXN=$P(DXN,U,5)
  1.  ... S @GLOB@(BQDFN,"CRITERIA",DXN,"V",VIS,IEN)=$P(^AUPNVSIT(VIS,0),U,1)_U_U_IEN_U_9000010.07
  1.  Q
  1.  ;
  1. EPG(BQIDFN) ;EP - Pregnancy ended?
  1.  NEW X,NREF,TAX,X
  1.  S NREF="ARRAY" K @NREF
  1.  F TAX="BGP MISCARRIAGE/ABORTION DXS","SURVEILLANCE H1N1 DELIVERY DX" D BLD^BQITUTL(TAX,NREF)
  1.  S X=$$TAX^BQITRUTL("T-8M","",1,BQIDFN,9000010.07,"","",.NREF)
  1.  I X Q 1
  1.  S NREF="ARRAY" K @NREF
  1.  F TAX="BGP ABORTION PROCEDURES","BQI DELIVERY PROCEDURES" D BLD^BQITUTL(TAX,NREF)
  1.  S X=$$TAX^BQITRUTL("T-8M","",1,BQIDFN,9000010.08,"","",.NREF)
  1.  I X Q 1
  1.  S NREF="BQITAX" K @NREF
  1.  F TAX="BGP CPT ABORTION","BGP CPT MISCARRIAGE","SURVEILLANCE H1N1 DELIVERY CPT" D BLD^BQITUTL(TAX,NREF)
  1.  S X=$$TAX^BQITRUTL("T-8M","",1,BQIDFN,9000010.18,"","",.NREF)
  1.  I X Q 1
  1.  Q 0