BQITD13 ;VNGT/HS/ALA-Pregnancy ; 15 Jun 2011 9:13 AM
;;2.4;ICARE MANAGEMENT SYSTEM;;Apr 01, 2015;Build 41
;
;
POP(BQARY,TGLOB) ; EP
;
;Description
; Finds all patients who meet the criteria for currently pregnant
;Input
; BQARY - Array of taxonomies and other information
; TGLOB - Global where data is to be stored
; Structure:
; TGLOB(DFN,"CRITERIA",criteria or taxonomy,visit or problem ien)=date/time
;
NEW BQFLG,BQTIME,BQTM
S BQFLG=$P($G(^BQI(90508,1,16)),U,1),BQTIME=$P($G(^BQI(90508,1,16)),U,2)
; ILI Algorithm
I BQFLG="L" D
. NEW BQDFN
. S BQDFN=0
. F S BQDFN=$O(^DPT(BQDFN)) Q:'BQDFN D
.. I $$PNM^APCLSIL1(BQDFN,DT)="Y" S @TGLOB@(BQDFN)=""
;
; iCare Algorithm
I BQFLG="I" D
. NEW REVPER,TREF,NREF,TAX,EDATE,TMGL,BDFN,BDTM,VIS,IEN,DXN
. S BQTM=(BQTIME*30.4167)
. S EDATE=DT
. S REVPER=$$FMADD^XLFDT(EDATE,-(BQTM))
. S TREF=$NA(^TMP("BQITAX",UID)) K @TREF
. F TAX="BQI PREGNANCY DXS" D BLD^BQITUTL(TAX,TREF)
. S TMGL=$NA(^TMP("BQIPREG",UID)) K @TMGL
. D POV(.TMGL,TREF,REVPER,"")
. ;
. ; Exceptions
. S NREF="ARRAY" K @NREF
. F TAX="BGP MISCARRIAGE/ABORTION DXS","SURVEILLANCE H1N1 DELIVERY DX" D BLD^BQITUTL(TAX,NREF)
. D EPOV(.TMGL,.NREF,REVPER,"")
. K @NREF,@TREF
. ; Procedures
. S NREF="ARRAY" K @NREF
. F TAX="BGP ABORTION PROCEDURES","BQI DELIVERY PROCEDURES" D BLD^BQITUTL(TAX,NREF)
. D EPRC(.TMGL,.NREF,REVPER,"")
. ; CPTs
. S TREF="BQITAX" K @TREF
. F TAX="BGP CPT ABORTION","BGP CPT MISCARRIAGE","SURVEILLANCE H1N1 DELIVERY CPT" D BLD^BQITUTL(TAX,TREF)
. D ECPT(.TMGL,.TREF,REVPER,"")
. K @TREF
. ;
. S BDFN=""
. F S BDFN=$O(@TMGL@(BDFN)) Q:BDFN="" D PARS(BDFN,TGLOB)
Q
;
POV(GLB,TREF,REVPER,BQDFN) ;EP
NEW TIEN,VDATA,PDATA,VISIT,VSDTM,IEN,DFN,BGDT,ENDT
I $G(BQDFN)="" D
. S TIEN=""
. F S TIEN=$O(@TREF@(TIEN)) Q:TIEN="" D
.. S IEN=""
.. F S IEN=$O(^AUPNVPOV("B",TIEN,IEN),-1) Q:IEN="" D
... S PDATA=$G(^AUPNVPOV(IEN,0)) I PDATA="" Q
... S VISIT=$P(PDATA,U,3) I VISIT="" Q
... S VDATA=$G(^AUPNVSIT(VISIT,0)) I VDATA="" Q
... I $P(VDATA,U,11)=1 Q
... Q:"AORSHI"'[$P(VDATA,U,7)
... S VSDTM=$P(VDATA,U,1)\1 I VSDTM=0 Q
... I VSDTM<REVPER!(VSDTM>EDATE) Q
... S TYP=@TREF@(TIEN),DFN=$P(VDATA,U,5)
... S @GLB@(DFN,VSDTM,VISIT,IEN)=TYP_U_TAX
;
I $G(BQDFN)'="" D
. S BGDT=(9999999-DT)-1,ENDT=9999999-REVPER
. F S BGDT=$O(^AUPNVPOV("AA",BQDFN,BGDT)) Q:BGDT=""!(BGDT>ENDT) D
.. S IEN=""
.. F S IEN=$O(^AUPNVPOV("AA",BQDFN,BGDT,IEN)) Q:IEN="" D
... S PDATA=$G(^AUPNVPOV(IEN,0)) I PDATA="" Q
... S TIEN=$P(PDATA,U,1)
... I '$D(@TREF@(TIEN)) Q
... S VISIT=$P(PDATA,U,3) I VISIT="" Q
... S VDATA=$G(^AUPNVSIT(VISIT,0)) I VDATA="" Q
... I $P(VDATA,U,11)=1 Q
... Q:"AORSHI"'[$P(VDATA,U,7)
... S VSDTM=$P(VDATA,U,1)\1 I VSDTM=0 Q
... S TYP=@TREF@(TIEN),DFN=$P(VDATA,U,5)
... S @GLB@(DFN,VSDTM,VISIT,IEN)=TYP_U_TAX
Q
;
EPOV(GLB,TREF,REVPER,BQDFN) ;EP
NEW TIEN,VDATA,PDATA,VISIT,VSDTM,IEN,DFN
I $G(BQDFN)="" D
. S TIEN=""
. F S TIEN=$O(@TREF@(TIEN)) Q:TIEN="" D
.. S IEN=""
.. F S IEN=$O(^AUPNVPOV("B",TIEN,IEN),-1) Q:IEN="" D
... S PDATA=$G(^AUPNVPOV(IEN,0)) I PDATA="" Q
... S VISIT=$P(PDATA,U,3) I VISIT="" Q
... S VDATA=$G(^AUPNVSIT(VISIT,0)) I VDATA="" Q
... I $P(VDATA,U,11)=1 Q
... Q:"AORSHI"'[$P(VDATA,U,7)
... S VSDTM=$P(VDATA,U,1)\1 I VSDTM=0 Q
... I VSDTM<REVPER!(VSDTM>EDATE) Q
... S DFN=$P(VDATA,U,5)
... I $D(@GLB@(DFN)) D
.... NEW PDTM
.... S PDTM="" F S PDTM=$O(@GLB@(DFN,PDTM)) Q:PDTM="" D
..... I PDTM<VSDTM K @GLB@(DFN,PDTM)
;
I $G(BQDFN)'="" D
. S BGDT=(9999999-DT)-1,ENDT=9999999-REVPER
. F S BGDT=$O(^AUPNVPOV("AA",BQDFN,BGDT)) Q:BGDT=""!(BGDT>ENDT) D
.. S IEN=""
.. F S IEN=$O(^AUPNVPOV("AA",BQDFN,BGDT,IEN)) Q:IEN="" D
... S PDATA=$G(^AUPNVPOV(IEN,0)) I PDATA="" Q
... S TIEN=$P(PDATA,U,1)
... I '$D(@TREF@(TIEN)) Q
... S VISIT=$P(PDATA,U,3) I VISIT="" Q
... S VDATA=$G(^AUPNVSIT(VISIT,0)) I VDATA="" Q
... I $P(VDATA,U,11)=1 Q
... Q:"AORSHI"'[$P(VDATA,U,7)
... S DFN=$P(VDATA,U,5),VSDTM=$P(VDATA,U,1)\1
... I $D(@GLB@(DFN)) D
.... NEW PDTM
.... S PDTM="" F S PDTM=$O(@GLB@(DFN,PDTM)) Q:PDTM="" D
..... I PDTM<VSDTM K @GLB@(DFN,PDTM)
Q
;
ECPT(GLB,TREF,REVPER,BQDFN) ;
NEW TIEN,VDATA,PDATA,VISIT,VSDTM,DFN
I $G(BQDFN)="" D
. S TIEN=""
. F S TIEN=$O(@TREF@(TIEN)) Q:TIEN="" D
.. S IEN=""
.. F S IEN=$O(^AUPNVCPT("B",TIEN,IEN),-1) Q:IEN="" D
... S PDATA=$G(^AUPNVCPT(IEN,0)) I PDATA="" Q
... S VISIT=$P(PDATA,U,3) I VISIT="" Q
... S VDATA=$G(^AUPNVSIT(VISIT,0)) I VDATA="" Q
... I $P(VDATA,U,11)=1 Q
... Q:"AORSHI"'[$P(VDATA,U,7)
... S VSDTM=$P(VDATA,U,1)\1 I VSDTM=0 Q
... I VSDTM<REVPER!(VSDTM>EDATE) Q
... S DFN=$P(VDATA,U,5)
... I $D(@GLB@(DFN)) D
.... NEW PDTM
.... S PDTM="" F S PDTM=$O(@GLB@(DFN,PDTM)) Q:PDTM="" D
..... I PDTM<VSDTM K @GLB@(DFN,PDTM)
;
I $G(BQDFN)'="" D
. S BGDT=(9999999-DT)-1,ENDT=9999999-REVPER
. S TIEN=""
. F S TIEN=$O(@TREF@(TIEN)) Q:TIEN="" D
.. F S BGDT=$O(^AUPNVCPT("AA",BQDFN,TIEN,BGDT)) Q:BGDT=""!(BGDT>ENDT) D
... S IEN=""
... F S IEN=$O(^AUPNVCPT("AA",BQDFN,TIEN,BGDT,IEN)) Q:IEN="" D
.... S PDATA=$G(^AUPNVCPT(IEN,0)) I PDATA="" Q
.... S VISIT=$P(PDATA,U,3) I VISIT="" Q
.... S VDATA=$G(^AUPNVSIT(VISIT,0)) I VDATA="" Q
.... I $P(VDATA,U,11)=1 Q
.... Q:"AORSHI"'[$P(VDATA,U,7)
.... S DFN=$P(VDATA,U,5),VSDTM=$P(VDATA,U,1)\1
.... I $D(@GLB@(DFN)) D
..... NEW PDTM
..... S PDTM="" F S PDTM=$O(@GLB@(DFN,PDTM)) Q:PDTM="" D
...... I PDTM<VSDTM K @GLB@(DFN,PDTM)
Q
;
EPRC(GLB,TREF,REVPER,BQDFN) ;EP
NEW TIEN,VDATA,PDATA,VISIT,VSDTM,IEN,DFN
I $G(BQDFN)="" D
. S TIEN=""
. F S TIEN=$O(@TREF@(TIEN)) Q:TIEN="" D
.. S IEN=""
.. F S IEN=$O(^AUPNVPRC("B",TIEN,IEN),-1) Q:IEN="" D
... S PDATA=$G(^AUPNVPRC(IEN,0)) I PDATA="" Q
... S VISIT=$P(PDATA,U,3) I VISIT="" Q
... S VDATA=$G(^AUPNVSIT(VISIT,0)) I VDATA="" Q
... I $P(VDATA,U,11)=1 Q
... Q:"AORSHI"'[$P(VDATA,U,7)
... S VSDTM=$P(VDATA,U,1)\1 I VSDTM=0 Q
... I VSDTM<REVPER!(VSDTM>EDATE) Q
... S DFN=$P(VDATA,U,5)
... I $D(@GLB@(DFN)) D
.... NEW PDTM
.... S PDTM="" F S PDTM=$O(@GLB@(DFN,PDTM)) Q:PDTM="" D
..... I PDTM<VSDTM K @GLB@(DFN,PDTM)
;
I $G(BQDFN)'="" D
. S BGDT=(9999999-DT)-1,ENDT=9999999-REVPER
. F S BGDT=$O(^AUPNVPRC("AA",BQDFN,BGDT)) Q:BGDT=""!(BGDT>ENDT) D
.. S IEN=""
.. F S IEN=$O(^AUPNVPRC("AA",BQDFN,BGDT,IEN)) Q:IEN="" D
... S PDATA=$G(^AUPNVPRC(IEN,0)) I PDATA="" Q
... S TIEN=$P(PDATA,U,1)
... I '$D(@TREF@(TIEN)) Q
... S VISIT=$P(PDATA,U,3) I VISIT="" Q
... S VDATA=$G(^AUPNVSIT(VISIT,0)) I VDATA="" Q
... I $P(VDATA,U,11)=1 Q
... Q:"AORSHI"'[$P(VDATA,U,7)
... S DFN=$P(VDATA,U,5),VSDTM=$P(VDATA,U,1)\1
... I $D(@GLB@(DFN)) D
.... NEW PDTM
.... S PDTM="" F S PDTM=$O(@GLB@(DFN,PDTM)) Q:PDTM="" D
..... I PDTM<VSDTM K @GLB@(DFN,PDTM)
Q
;
PAT(DEF,BTGLOB,BDFN) ;EP -- Get value for a single patient
NEW DXOK,BQDXN,BQREF,BQFLG,BQTIME,BQTM,EDATE,REVPER,TREF,TAX,TMGL,NREF
S BQFLG=$P($G(^BQI(90508,1,16)),U,1),BQTIME=$P($G(^BQI(90508,1,16)),U,2)
S DXOK=0
; ILI Algorithm
I BQFLG="L" D
. I $$PNM^APCLSIL1(BDFN,DT)="Y" S DXOK=1
;
; iCare Algorithm
I BQFLG="I" D
. S BQTM=(BQTIME*30.4167)
. S EDATE=DT
. S REVPER=$$FMADD^XLFDT(EDATE,-(BQTM))
. S TREF=$NA(^TMP("BQITAX",UID)) K @TREF
. F TAX="BQI PREGNANCY DXS" D BLD^BQITUTL(TAX,TREF)
. S TMGL=$NA(^TMP("BQIPREG",UID)) K @TMGL
. D POV(.TMGL,TREF,REVPER,BDFN)
. ;
. ; Exceptions
. S NREF="ARRAY" K @NREF
. F TAX="BGP MISCARRIAGE/ABORTION DXS","SURVEILLANCE H1N1 DELIVERY DX" D BLD^BQITUTL(TAX,NREF)
. D EPOV(.TMGL,.NREF,REVPER,BDFN)
. K @NREF,@TREF
. ; Procedures
. S NREF="ARRAY" K @NREF
. F TAX="BGP ABORTION PROCEDURES","BQI DELIVERY PROCEDURES" D BLD^BQITUTL(TAX,NREF)
. D EPRC(.TMGL,.NREF,REVPER,BDFN)
. ; CPTs
. S TREF="BQITAX" K @TREF
. F TAX="BGP CPT ABORTION","BGP CPT MISCARRIAGE","SURVEILLANCE H1N1 DELIVERY CPT" D BLD^BQITUTL(TAX,TREF)
. D ECPT(.TMGL,.TREF,REVPER,BDFN)
. K @TREF
. ;
. I $D(@TMGL@(BDFN)) S DXOK=1 D PARS(BDFN,BTGLOB)
Q DXOK
;
PARS(BQDFN,GLOB) ;EP
NEW BDTM,VIS,IEN,DXN
S BDTM="" F S BDTM=$O(@TMGL@(BQDFN,BDTM)) Q:BDTM="" D
. S VIS="" F S VIS=$O(@TMGL@(BQDFN,BDTM,VIS)) Q:VIS="" D
.. S IEN="" F S IEN=$O(@TMGL@(BQDFN,BDTM,VIS,IEN)) Q:IEN="" D
... S DXN=@TMGL@(BQDFN,BDTM,VIS,IEN)
... I $P(DXN,U,5)'="" S DXN=$P(DXN,U,5)
... S @GLOB@(BQDFN,"CRITERIA",DXN,"V",VIS,IEN)=$P(^AUPNVSIT(VIS,0),U,1)_U_U_IEN_U_9000010.07
Q
;
EPG(BQIDFN) ;EP - Pregnancy ended?
NEW X,NREF,TAX,X
S NREF="ARRAY" K @NREF
F TAX="BGP MISCARRIAGE/ABORTION DXS","SURVEILLANCE H1N1 DELIVERY DX" D BLD^BQITUTL(TAX,NREF)
S X=$$TAX^BQITRUTL("T-8M","",1,BQIDFN,9000010.07,"","",.NREF)
I X Q 1
S NREF="ARRAY" K @NREF
F TAX="BGP ABORTION PROCEDURES","BQI DELIVERY PROCEDURES" D BLD^BQITUTL(TAX,NREF)
S X=$$TAX^BQITRUTL("T-8M","",1,BQIDFN,9000010.08,"","",.NREF)
I X Q 1
S NREF="BQITAX" K @NREF
F TAX="BGP CPT ABORTION","BGP CPT MISCARRIAGE","SURVEILLANCE H1N1 DELIVERY CPT" D BLD^BQITUTL(TAX,NREF)
S X=$$TAX^BQITRUTL("T-8M","",1,BQIDFN,9000010.18,"","",.NREF)
I X Q 1
Q 0
BQITD13 ;VNGT/HS/ALA-Pregnancy ; 15 Jun 2011 9:13 AM
+1 ;;2.4;ICARE MANAGEMENT SYSTEM;;Apr 01, 2015;Build 41
+2 ;
+3 ;
POP(BQARY,TGLOB) ; EP
+1 ;
+2 ;Description
+3 ; Finds all patients who meet the criteria for currently pregnant
+4 ;Input
+5 ; BQARY - Array of taxonomies and other information
+6 ; TGLOB - Global where data is to be stored
+7 ; Structure:
+8 ; TGLOB(DFN,"CRITERIA",criteria or taxonomy,visit or problem ien)=date/time
+9 ;
+10 NEW BQFLG,BQTIME,BQTM
+11 SET BQFLG=$PIECE($GET(^BQI(90508,1,16)),U,1)
SET BQTIME=$PIECE($GET(^BQI(90508,1,16)),U,2)
+12 ; ILI Algorithm
+13 IF BQFLG="L"
Begin DoDot:1
+14 NEW BQDFN
+15 SET BQDFN=0
+16 FOR
SET BQDFN=$ORDER(^DPT(BQDFN))
IF 'BQDFN
QUIT
Begin DoDot:2
+17 IF $$PNM^APCLSIL1(BQDFN,DT)="Y"
SET @TGLOB@(BQDFN)=""
End DoDot:2
End DoDot:1
+18 ;
+19 ; iCare Algorithm
+20 IF BQFLG="I"
Begin DoDot:1
+21 NEW REVPER,TREF,NREF,TAX,EDATE,TMGL,BDFN,BDTM,VIS,IEN,DXN
+22 SET BQTM=(BQTIME*30.4167)
+23 SET EDATE=DT
+24 SET REVPER=$$FMADD^XLFDT(EDATE,-(BQTM))
+25 SET TREF=$NAME(^TMP("BQITAX",UID))
KILL @TREF
+26 FOR TAX="BQI PREGNANCY DXS"
DO BLD^BQITUTL(TAX,TREF)
+27 SET TMGL=$NAME(^TMP("BQIPREG",UID))
KILL @TMGL
+28 DO POV(.TMGL,TREF,REVPER,"")
+29 ;
+30 ; Exceptions
+31 SET NREF="ARRAY"
KILL @NREF
+32 FOR TAX="BGP MISCARRIAGE/ABORTION DXS","SURVEILLANCE H1N1 DELIVERY DX"
DO BLD^BQITUTL(TAX,NREF)
+33 DO EPOV(.TMGL,.NREF,REVPER,"")
+34 KILL @NREF,@TREF
+35 ; Procedures
+36 SET NREF="ARRAY"
KILL @NREF
+37 FOR TAX="BGP ABORTION PROCEDURES","BQI DELIVERY PROCEDURES"
DO BLD^BQITUTL(TAX,NREF)
+38 DO EPRC(.TMGL,.NREF,REVPER,"")
+39 ; CPTs
+40 SET TREF="BQITAX"
KILL @TREF
+41 FOR TAX="BGP CPT ABORTION","BGP CPT MISCARRIAGE","SURVEILLANCE H1N1 DELIVERY CPT"
DO BLD^BQITUTL(TAX,TREF)
+42 DO ECPT(.TMGL,.TREF,REVPER,"")
+43 KILL @TREF
+44 ;
+45 SET BDFN=""
+46 FOR
SET BDFN=$ORDER(@TMGL@(BDFN))
IF BDFN=""
QUIT
DO PARS(BDFN,TGLOB)
End DoDot:1
+47 QUIT
+48 ;
POV(GLB,TREF,REVPER,BQDFN) ;EP
+1 NEW TIEN,VDATA,PDATA,VISIT,VSDTM,IEN,DFN,BGDT,ENDT
+2 IF $GET(BQDFN)=""
Begin DoDot:1
+3 SET TIEN=""
+4 FOR
SET TIEN=$ORDER(@TREF@(TIEN))
IF TIEN=""
QUIT
Begin DoDot:2
+5 SET IEN=""
+6 FOR
SET IEN=$ORDER(^AUPNVPOV("B",TIEN,IEN),-1)
IF IEN=""
QUIT
Begin DoDot:3
+7 SET PDATA=$GET(^AUPNVPOV(IEN,0))
IF PDATA=""
QUIT
+8 SET VISIT=$PIECE(PDATA,U,3)
IF VISIT=""
QUIT
+9 SET VDATA=$GET(^AUPNVSIT(VISIT,0))
IF VDATA=""
QUIT
+10 IF $PIECE(VDATA,U,11)=1
QUIT
+11 IF "AORSHI"'[$PIECE(VDATA,U,7)
QUIT
+12 SET VSDTM=$PIECE(VDATA,U,1)\1
IF VSDTM=0
QUIT
+13 IF VSDTM<REVPER!(VSDTM>EDATE)
QUIT
+14 SET TYP=@TREF@(TIEN)
SET DFN=$PIECE(VDATA,U,5)
+15 SET @GLB@(DFN,VSDTM,VISIT,IEN)=TYP_U_TAX
End DoDot:3
End DoDot:2
End DoDot:1
+16 ;
+17 IF $GET(BQDFN)'=""
Begin DoDot:1
+18 SET BGDT=(9999999-DT)-1
SET ENDT=9999999-REVPER
+19 FOR
SET BGDT=$ORDER(^AUPNVPOV("AA",BQDFN,BGDT))
IF BGDT=""!(BGDT>ENDT)
QUIT
Begin DoDot:2
+20 SET IEN=""
+21 FOR
SET IEN=$ORDER(^AUPNVPOV("AA",BQDFN,BGDT,IEN))
IF IEN=""
QUIT
Begin DoDot:3
+22 SET PDATA=$GET(^AUPNVPOV(IEN,0))
IF PDATA=""
QUIT
+23 SET TIEN=$PIECE(PDATA,U,1)
+24 IF '$DATA(@TREF@(TIEN))
QUIT
+25 SET VISIT=$PIECE(PDATA,U,3)
IF VISIT=""
QUIT
+26 SET VDATA=$GET(^AUPNVSIT(VISIT,0))
IF VDATA=""
QUIT
+27 IF $PIECE(VDATA,U,11)=1
QUIT
+28 IF "AORSHI"'[$PIECE(VDATA,U,7)
QUIT
+29 SET VSDTM=$PIECE(VDATA,U,1)\1
IF VSDTM=0
QUIT
+30 SET TYP=@TREF@(TIEN)
SET DFN=$PIECE(VDATA,U,5)
+31 SET @GLB@(DFN,VSDTM,VISIT,IEN)=TYP_U_TAX
End DoDot:3
End DoDot:2
End DoDot:1
+32 QUIT
+33 ;
EPOV(GLB,TREF,REVPER,BQDFN) ;EP
+1 NEW TIEN,VDATA,PDATA,VISIT,VSDTM,IEN,DFN
+2 IF $GET(BQDFN)=""
Begin DoDot:1
+3 SET TIEN=""
+4 FOR
SET TIEN=$ORDER(@TREF@(TIEN))
IF TIEN=""
QUIT
Begin DoDot:2
+5 SET IEN=""
+6 FOR
SET IEN=$ORDER(^AUPNVPOV("B",TIEN,IEN),-1)
IF IEN=""
QUIT
Begin DoDot:3
+7 SET PDATA=$GET(^AUPNVPOV(IEN,0))
IF PDATA=""
QUIT
+8 SET VISIT=$PIECE(PDATA,U,3)
IF VISIT=""
QUIT
+9 SET VDATA=$GET(^AUPNVSIT(VISIT,0))
IF VDATA=""
QUIT
+10 IF $PIECE(VDATA,U,11)=1
QUIT
+11 IF "AORSHI"'[$PIECE(VDATA,U,7)
QUIT
+12 SET VSDTM=$PIECE(VDATA,U,1)\1
IF VSDTM=0
QUIT
+13 IF VSDTM<REVPER!(VSDTM>EDATE)
QUIT
+14 SET DFN=$PIECE(VDATA,U,5)
+15 IF $DATA(@GLB@(DFN))
Begin DoDot:4
+16 NEW PDTM
+17 SET PDTM=""
FOR
SET PDTM=$ORDER(@GLB@(DFN,PDTM))
IF PDTM=""
QUIT
Begin DoDot:5
+18 IF PDTM<VSDTM
KILL @GLB@(DFN,PDTM)
End DoDot:5
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+19 ;
+20 IF $GET(BQDFN)'=""
Begin DoDot:1
+21 SET BGDT=(9999999-DT)-1
SET ENDT=9999999-REVPER
+22 FOR
SET BGDT=$ORDER(^AUPNVPOV("AA",BQDFN,BGDT))
IF BGDT=""!(BGDT>ENDT)
QUIT
Begin DoDot:2
+23 SET IEN=""
+24 FOR
SET IEN=$ORDER(^AUPNVPOV("AA",BQDFN,BGDT,IEN))
IF IEN=""
QUIT
Begin DoDot:3
+25 SET PDATA=$GET(^AUPNVPOV(IEN,0))
IF PDATA=""
QUIT
+26 SET TIEN=$PIECE(PDATA,U,1)
+27 IF '$DATA(@TREF@(TIEN))
QUIT
+28 SET VISIT=$PIECE(PDATA,U,3)
IF VISIT=""
QUIT
+29 SET VDATA=$GET(^AUPNVSIT(VISIT,0))
IF VDATA=""
QUIT
+30 IF $PIECE(VDATA,U,11)=1
QUIT
+31 IF "AORSHI"'[$PIECE(VDATA,U,7)
QUIT
+32 SET DFN=$PIECE(VDATA,U,5)
SET VSDTM=$PIECE(VDATA,U,1)\1
+33 IF $DATA(@GLB@(DFN))
Begin DoDot:4
+34 NEW PDTM
+35 SET PDTM=""
FOR
SET PDTM=$ORDER(@GLB@(DFN,PDTM))
IF PDTM=""
QUIT
Begin DoDot:5
+36 IF PDTM<VSDTM
KILL @GLB@(DFN,PDTM)
End DoDot:5
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+37 QUIT
+38 ;
ECPT(GLB,TREF,REVPER,BQDFN) ;
+1 NEW TIEN,VDATA,PDATA,VISIT,VSDTM,DFN
+2 IF $GET(BQDFN)=""
Begin DoDot:1
+3 SET TIEN=""
+4 FOR
SET TIEN=$ORDER(@TREF@(TIEN))
IF TIEN=""
QUIT
Begin DoDot:2
+5 SET IEN=""
+6 FOR
SET IEN=$ORDER(^AUPNVCPT("B",TIEN,IEN),-1)
IF IEN=""
QUIT
Begin DoDot:3
+7 SET PDATA=$GET(^AUPNVCPT(IEN,0))
IF PDATA=""
QUIT
+8 SET VISIT=$PIECE(PDATA,U,3)
IF VISIT=""
QUIT
+9 SET VDATA=$GET(^AUPNVSIT(VISIT,0))
IF VDATA=""
QUIT
+10 IF $PIECE(VDATA,U,11)=1
QUIT
+11 IF "AORSHI"'[$PIECE(VDATA,U,7)
QUIT
+12 SET VSDTM=$PIECE(VDATA,U,1)\1
IF VSDTM=0
QUIT
+13 IF VSDTM<REVPER!(VSDTM>EDATE)
QUIT
+14 SET DFN=$PIECE(VDATA,U,5)
+15 IF $DATA(@GLB@(DFN))
Begin DoDot:4
+16 NEW PDTM
+17 SET PDTM=""
FOR
SET PDTM=$ORDER(@GLB@(DFN,PDTM))
IF PDTM=""
QUIT
Begin DoDot:5
+18 IF PDTM<VSDTM
KILL @GLB@(DFN,PDTM)
End DoDot:5
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+19 ;
+20 IF $GET(BQDFN)'=""
Begin DoDot:1
+21 SET BGDT=(9999999-DT)-1
SET ENDT=9999999-REVPER
+22 SET TIEN=""
+23 FOR
SET TIEN=$ORDER(@TREF@(TIEN))
IF TIEN=""
QUIT
Begin DoDot:2
+24 FOR
SET BGDT=$ORDER(^AUPNVCPT("AA",BQDFN,TIEN,BGDT))
IF BGDT=""!(BGDT>ENDT)
QUIT
Begin DoDot:3
+25 SET IEN=""
+26 FOR
SET IEN=$ORDER(^AUPNVCPT("AA",BQDFN,TIEN,BGDT,IEN))
IF IEN=""
QUIT
Begin DoDot:4
+27 SET PDATA=$GET(^AUPNVCPT(IEN,0))
IF PDATA=""
QUIT
+28 SET VISIT=$PIECE(PDATA,U,3)
IF VISIT=""
QUIT
+29 SET VDATA=$GET(^AUPNVSIT(VISIT,0))
IF VDATA=""
QUIT
+30 IF $PIECE(VDATA,U,11)=1
QUIT
+31 IF "AORSHI"'[$PIECE(VDATA,U,7)
QUIT
+32 SET DFN=$PIECE(VDATA,U,5)
SET VSDTM=$PIECE(VDATA,U,1)\1
+33 IF $DATA(@GLB@(DFN))
Begin DoDot:5
+34 NEW PDTM
+35 SET PDTM=""
FOR
SET PDTM=$ORDER(@GLB@(DFN,PDTM))
IF PDTM=""
QUIT
Begin DoDot:6
+36 IF PDTM<VSDTM
KILL @GLB@(DFN,PDTM)
End DoDot:6
End DoDot:5
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+37 QUIT
+38 ;
EPRC(GLB,TREF,REVPER,BQDFN) ;EP
+1 NEW TIEN,VDATA,PDATA,VISIT,VSDTM,IEN,DFN
+2 IF $GET(BQDFN)=""
Begin DoDot:1
+3 SET TIEN=""
+4 FOR
SET TIEN=$ORDER(@TREF@(TIEN))
IF TIEN=""
QUIT
Begin DoDot:2
+5 SET IEN=""
+6 FOR
SET IEN=$ORDER(^AUPNVPRC("B",TIEN,IEN),-1)
IF IEN=""
QUIT
Begin DoDot:3
+7 SET PDATA=$GET(^AUPNVPRC(IEN,0))
IF PDATA=""
QUIT
+8 SET VISIT=$PIECE(PDATA,U,3)
IF VISIT=""
QUIT
+9 SET VDATA=$GET(^AUPNVSIT(VISIT,0))
IF VDATA=""
QUIT
+10 IF $PIECE(VDATA,U,11)=1
QUIT
+11 IF "AORSHI"'[$PIECE(VDATA,U,7)
QUIT
+12 SET VSDTM=$PIECE(VDATA,U,1)\1
IF VSDTM=0
QUIT
+13 IF VSDTM<REVPER!(VSDTM>EDATE)
QUIT
+14 SET DFN=$PIECE(VDATA,U,5)
+15 IF $DATA(@GLB@(DFN))
Begin DoDot:4
+16 NEW PDTM
+17 SET PDTM=""
FOR
SET PDTM=$ORDER(@GLB@(DFN,PDTM))
IF PDTM=""
QUIT
Begin DoDot:5
+18 IF PDTM<VSDTM
KILL @GLB@(DFN,PDTM)
End DoDot:5
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+19 ;
+20 IF $GET(BQDFN)'=""
Begin DoDot:1
+21 SET BGDT=(9999999-DT)-1
SET ENDT=9999999-REVPER
+22 FOR
SET BGDT=$ORDER(^AUPNVPRC("AA",BQDFN,BGDT))
IF BGDT=""!(BGDT>ENDT)
QUIT
Begin DoDot:2
+23 SET IEN=""
+24 FOR
SET IEN=$ORDER(^AUPNVPRC("AA",BQDFN,BGDT,IEN))
IF IEN=""
QUIT
Begin DoDot:3
+25 SET PDATA=$GET(^AUPNVPRC(IEN,0))
IF PDATA=""
QUIT
+26 SET TIEN=$PIECE(PDATA,U,1)
+27 IF '$DATA(@TREF@(TIEN))
QUIT
+28 SET VISIT=$PIECE(PDATA,U,3)
IF VISIT=""
QUIT
+29 SET VDATA=$GET(^AUPNVSIT(VISIT,0))
IF VDATA=""
QUIT
+30 IF $PIECE(VDATA,U,11)=1
QUIT
+31 IF "AORSHI"'[$PIECE(VDATA,U,7)
QUIT
+32 SET DFN=$PIECE(VDATA,U,5)
SET VSDTM=$PIECE(VDATA,U,1)\1
+33 IF $DATA(@GLB@(DFN))
Begin DoDot:4
+34 NEW PDTM
+35 SET PDTM=""
FOR
SET PDTM=$ORDER(@GLB@(DFN,PDTM))
IF PDTM=""
QUIT
Begin DoDot:5
+36 IF PDTM<VSDTM
KILL @GLB@(DFN,PDTM)
End DoDot:5
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+37 QUIT
+38 ;
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
+2 SET BQFLG=$PIECE($GET(^BQI(90508,1,16)),U,1)
SET BQTIME=$PIECE($GET(^BQI(90508,1,16)),U,2)
+3 SET DXOK=0
+4 ; ILI Algorithm
+5 IF BQFLG="L"
Begin DoDot:1
+6 IF $$PNM^APCLSIL1(BDFN,DT)="Y"
SET DXOK=1
End DoDot:1
+7 ;
+8 ; iCare Algorithm
+9 IF BQFLG="I"
Begin DoDot:1
+10 SET BQTM=(BQTIME*30.4167)
+11 SET EDATE=DT
+12 SET REVPER=$$FMADD^XLFDT(EDATE,-(BQTM))
+13 SET TREF=$NAME(^TMP("BQITAX",UID))
KILL @TREF
+14 FOR TAX="BQI PREGNANCY DXS"
DO BLD^BQITUTL(TAX,TREF)
+15 SET TMGL=$NAME(^TMP("BQIPREG",UID))
KILL @TMGL
+16 DO POV(.TMGL,TREF,REVPER,BDFN)
+17 ;
+18 ; Exceptions
+19 SET NREF="ARRAY"
KILL @NREF
+20 FOR TAX="BGP MISCARRIAGE/ABORTION DXS","SURVEILLANCE H1N1 DELIVERY DX"
DO BLD^BQITUTL(TAX,NREF)
+21 DO EPOV(.TMGL,.NREF,REVPER,BDFN)
+22 KILL @NREF,@TREF
+23 ; Procedures
+24 SET NREF="ARRAY"
KILL @NREF
+25 FOR TAX="BGP ABORTION PROCEDURES","BQI DELIVERY PROCEDURES"
DO BLD^BQITUTL(TAX,NREF)
+26 DO EPRC(.TMGL,.NREF,REVPER,BDFN)
+27 ; CPTs
+28 SET TREF="BQITAX"
KILL @TREF
+29 FOR TAX="BGP CPT ABORTION","BGP CPT MISCARRIAGE","SURVEILLANCE H1N1 DELIVERY CPT"
DO BLD^BQITUTL(TAX,TREF)
+30 DO ECPT(.TMGL,.TREF,REVPER,BDFN)
+31 KILL @TREF
+32 ;
+33 IF $DATA(@TMGL@(BDFN))
SET DXOK=1
DO PARS(BDFN,BTGLOB)
End DoDot:1
+34 QUIT DXOK
+35 ;
PARS(BQDFN,GLOB) ;EP
+1 NEW BDTM,VIS,IEN,DXN
+2 SET BDTM=""
FOR
SET BDTM=$ORDER(@TMGL@(BQDFN,BDTM))
IF BDTM=""
QUIT
Begin DoDot:1
+3 SET VIS=""
FOR
SET VIS=$ORDER(@TMGL@(BQDFN,BDTM,VIS))
IF VIS=""
QUIT
Begin DoDot:2
+4 SET IEN=""
FOR
SET IEN=$ORDER(@TMGL@(BQDFN,BDTM,VIS,IEN))
IF IEN=""
QUIT
Begin DoDot:3
+5 SET DXN=@TMGL@(BQDFN,BDTM,VIS,IEN)
+6 IF $PIECE(DXN,U,5)'=""
SET DXN=$PIECE(DXN,U,5)
+7 SET @GLOB@(BQDFN,"CRITERIA",DXN,"V",VIS,IEN)=$PIECE(^AUPNVSIT(VIS,0),U,1)_U_U_IEN_U_9000010.07
End DoDot:3
End DoDot:2
End DoDot:1
+8 QUIT
+9 ;
EPG(BQIDFN) ;EP - Pregnancy ended?
+1 NEW X,NREF,TAX,X
+2 SET NREF="ARRAY"
KILL @NREF
+3 FOR TAX="BGP MISCARRIAGE/ABORTION DXS","SURVEILLANCE H1N1 DELIVERY DX"
DO BLD^BQITUTL(TAX,NREF)
+4 SET X=$$TAX^BQITRUTL("T-8M","",1,BQIDFN,9000010.07,"","",.NREF)
+5 IF X
QUIT 1
+6 SET NREF="ARRAY"
KILL @NREF
+7 FOR TAX="BGP ABORTION PROCEDURES","BQI DELIVERY PROCEDURES"
DO BLD^BQITUTL(TAX,NREF)
+8 SET X=$$TAX^BQITRUTL("T-8M","",1,BQIDFN,9000010.08,"","",.NREF)
+9 IF X
QUIT 1
+10 SET NREF="BQITAX"
KILL @NREF
+11 FOR TAX="BGP CPT ABORTION","BGP CPT MISCARRIAGE","SURVEILLANCE H1N1 DELIVERY CPT"
DO BLD^BQITUTL(TAX,NREF)
+12 SET X=$$TAX^BQITRUTL("T-8M","",1,BQIDFN,9000010.18,"","",.NREF)
+13 IF X
QUIT 1
+14 QUIT 0
