- BGP7D714 ; IHS/CMI/LAB - measure 6 ;
- ;;17.1;IHS CLINICAL REPORTING;;MAY 10, 2017;Build 29
- ;
- PREG ;EP
- NEW B,E,A,CNT,BGPD,BGPG,X,Y,BGPDX,C,D,G,T,%,CTR,VIEN,DXT,PXT,CPTT,BGPV,H
- I '$G(FORM) S FORM=""
- I $G(CPBD)="" S CPBD=$$FMADD^XLFDT(BDATE,-365)
- I $G(CPED)="" S CPED=EDATE
- S A=""
- I $P($G(^AUPNREP(P,11)),U,1)="Y" D I A S BGPD=B G MA
- .S B=$P($G(^AUPNREP(P,11)),U,2) Q:B=""
- .Q:B<CPBD
- .Q:B>CPED
- .S A=1
- .Q
- S BGPD=""
- D ALLV^APCLAPIU(P,BDATE,EDATE,"BGPV")
- I '$D(BGPV) G PROB
- S B=0,CNT=0,BGPD="" ;if there is one before time frame set this to 1
- S NORXCHR=$G(NORXCHR)
- S NORX=$G(NORX)
- K BGPG
- S DXT=$O(^ATXAX("B","BGP PREGNANCY DIAGNOSES 2",0))
- S PXT=$O(^ATXAX("B","BGP PREGNANCY ICD PROCEDURES",0))
- S CPTT=$O(^ATXAX("B","BGP PREGNANCY CPT CODES",0))
- ;CHECK DX, PROCS, CPTS for 2 separate visits
- S B=0,CTR=0 F S CTR=$O(BGPV(CTR)) Q:CTR'=+CTR D
- .;get visit into VIEN
- .S VIEN=$P(BGPV(CTR),U,5)
- .S D=$$VD^APCLV(VIEN)
- .S C=$$CLINIC^APCLV(VIEN,"C")
- .I NORXCHR,C=39 Q
- .I NORX,C=39 Q
- .S C=$$PRIMPROV^APCLV(VIEN,"D")
- .I NORXCHR,C=53 Q ;no chr as primary provider
- .;now check for dx
- .S Y=0,H="" F S Y=$O(^AUPNVPOV("AD",VIEN,Y)) Q:Y'=+Y D
- ..S %=+^AUPNVPOV(Y,0)
- ..I $$ICD^BGP7UTL2(%,DXT,9) S BGPDX(D)="",CNT=CNT+1,H=1 I D>$$FMADD^XLFDT(EDATE,-365) S B=1
- .Q:H
- .;NOW GO THROUGH CPTS
- .S Y=0,H="" F S Y=$O(^AUPNVCPT("AD",VIEN,Y)) Q:Y'=+Y D
- ..S %=+^AUPNVCPT(Y,0)
- ..I $$ICD^BGP7UTL2(%,CPTT,1) I '$D(BGPDX(D)) S BGPDX(D)="",CNT=CNT+1,H=1 I D>$$FMADD^XLFDT(EDATE,-365) S B=1
- .Q:H
- .;NOW PROCEDURES
- .S Y=0,H="" F S Y=$O(^AUPNVPRC("AD",VIEN,Y)) Q:Y'=+Y D
- ..S %=+^AUPNVPRC(Y,0)
- ..I $$ICD^BGP7UTL2(%,PXT,0) I '$D(BGPDX(D)) S BGPDX(D)="",CNT=CNT+1,H=1 I D>$$FMADD^XLFDT(EDATE,-365) S B=1
- .Q:H
- .Q
- I CNT>1,B D G MA
- .;SET BGPD TO SECOND VISIT DATE
- .S X=0,C=0 F S X=$O(BGPDX(X)) Q:X'=+X!(C>1) S C=C+1 I C=2 S BGPD=X
- ;
- PROB ;
- I '$G(B) Q "" ;no pregnancy visit during time period ;-Lori fix in 09
- S T=$O(^ATXAX("B","BGP PREGNANCY DIAGNOSES 2",0))
- S (X,G)=0 F S X=$O(^AUPNPROB("AC",P,X)) Q:X'=+X!(G) D
- .Q:$P(^AUPNPROB(X,0),U,12)="D"
- .Q:$P(^AUPNPROB(X,0),U,12)="I"
- .Q:$P(^AUPNPROB(X,0),U,8)>EDATE
- .Q:$P(^AUPNPROB(X,0),U,8)<BDATE
- .S Y=$P(^AUPNPROB(X,0),U)
- .Q:'$$ICD^BGP7UTL2(Y,T,9)
- .S G=$P(^AUPNPROB(X,0),U,8)
- .Q
- I G=0,BGPD="" Q 0
- S BGPD=G
- MA ;now check for abortion or miscarriage
- K BGPG S Y="BGPG(" S X=P_"^LAST DX [BGP MISCARRIAGE/ABORTION DXS;DURING "_$$FMTE^XLFDT(BGPD)_"-"_$$FMTE^XLFDT(EDATE) S E=$$START1^APCLDF(X,Y)
- I $D(BGPG(1)) Q 0 ;HAD MIS/AB
- S BGPG=$$LASTPRC^BGP7UTL1(P,"BGP ABORTION PROCEDURES",BGPD,EDATE)
- I BGPG Q 0
- S T=$O(^ATXAX("B","BGP MISCARRIAGE/ABORTION DXS",0))
- S (X,G)=0 F S X=$O(^AUPNPROB("AC",P,X)) Q:X'=+X!(G) D
- .Q:$P(^AUPNPROB(X,0),U,12)="D"
- .Q:$P(^AUPNPROB(X,0),U,12)="I"
- .Q:$P(^AUPNPROB(X,0),U,8)<BGPD
- .Q:$P(^AUPNPROB(X,0),U,8)>EDATE
- .S Y=$P(^AUPNPROB(X,0),U)
- .Q:'$$ICD^BGP7UTL2(Y,T,9)
- .S G=1
- .Q
- I G Q 0
- ;now check CPTs for Abortion and Miscarriage
- S T=$O(^ATXAX("B","BGP CPT ABORTION",0))
- S %=$$CPT^BGP7DU(P,BGPD,EDATE,T,3)
- I %]"" Q 0
- S T=$O(^ATXAX("B","BGP CPT MISCARRIAGE",0))
- S %=$$CPT^BGP7DU(P,BGPD,EDATE,T,3)
- I %]"" Q 0
- S T=$O(^ATXAX("B","BGP CPT ABORTION",0))
- S %=$$TRAN^BGP7DU(P,BGPD,EDATE,T,3)
- I %]"" Q 0
- S T=$O(^ATXAX("B","BGP CPT MISCARRIAGE",0))
- S %=$$TRAN^BGP7DU(P,BGPD,EDATE,T,3)
- I %]"" Q 0
- I FORM="" Q 1
- Q 1_U_$$DATE^BGP7UTL(BGPD)
- BGP7D714 ; IHS/CMI/LAB - measure 6 ;
- +1 ;;17.1;IHS CLINICAL REPORTING;;MAY 10, 2017;Build 29
- +2 ;
- PREG ;EP
- +1 NEW B,E,A,CNT,BGPD,BGPG,X,Y,BGPDX,C,D,G,T,%,CTR,VIEN,DXT,PXT,CPTT,BGPV,H
- +2 IF '$GET(FORM)
- SET FORM=""
- +3 IF $GET(CPBD)=""
- SET CPBD=$$FMADD^XLFDT(BDATE,-365)
- +4 IF $GET(CPED)=""
- SET CPED=EDATE
- +5 SET A=""
- +6 IF $PIECE($GET(^AUPNREP(P,11)),U,1)="Y"
- Begin DoDot:1
- +7 SET B=$PIECE($GET(^AUPNREP(P,11)),U,2)
- IF B=""
- QUIT
- +8 IF B<CPBD
- QUIT
- +9 IF B>CPED
- QUIT
- +10 SET A=1
- +11 QUIT
- End DoDot:1
- IF A
- SET BGPD=B
- GOTO MA
- +12 SET BGPD=""
- +13 DO ALLV^APCLAPIU(P,BDATE,EDATE,"BGPV")
- +14 IF '$DATA(BGPV)
- GOTO PROB
- +15 ;if there is one before time frame set this to 1
- SET B=0
- SET CNT=0
- SET BGPD=""
- +16 SET NORXCHR=$GET(NORXCHR)
- +17 SET NORX=$GET(NORX)
- +18 KILL BGPG
- +19 SET DXT=$ORDER(^ATXAX("B","BGP PREGNANCY DIAGNOSES 2",0))
- +20 SET PXT=$ORDER(^ATXAX("B","BGP PREGNANCY ICD PROCEDURES",0))
- +21 SET CPTT=$ORDER(^ATXAX("B","BGP PREGNANCY CPT CODES",0))
- +22 ;CHECK DX, PROCS, CPTS for 2 separate visits
- +23 SET B=0
- SET CTR=0
- FOR
- SET CTR=$ORDER(BGPV(CTR))
- IF CTR'=+CTR
- QUIT
- Begin DoDot:1
- +24 ;get visit into VIEN
- +25 SET VIEN=$PIECE(BGPV(CTR),U,5)
- +26 SET D=$$VD^APCLV(VIEN)
- +27 SET C=$$CLINIC^APCLV(VIEN,"C")
- +28 IF NORXCHR
- IF C=39
- QUIT
- +29 IF NORX
- IF C=39
- QUIT
- +30 SET C=$$PRIMPROV^APCLV(VIEN,"D")
- +31 ;no chr as primary provider
- IF NORXCHR
- IF C=53
- QUIT
- +32 ;now check for dx
- +33 SET Y=0
- SET H=""
- FOR
- SET Y=$ORDER(^AUPNVPOV("AD",VIEN,Y))
- IF Y'=+Y
- QUIT
- Begin DoDot:2
- +34 SET %=+^AUPNVPOV(Y,0)
- +35 IF $$ICD^BGP7UTL2(%,DXT,9)
- SET BGPDX(D)=""
- SET CNT=CNT+1
- SET H=1
- IF D>$$FMADD^XLFDT(EDATE,-365)
- SET B=1
- End DoDot:2
- +36 IF H
- QUIT
- +37 ;NOW GO THROUGH CPTS
- +38 SET Y=0
- SET H=""
- FOR
- SET Y=$ORDER(^AUPNVCPT("AD",VIEN,Y))
- IF Y'=+Y
- QUIT
- Begin DoDot:2
- +39 SET %=+^AUPNVCPT(Y,0)
- +40 IF $$ICD^BGP7UTL2(%,CPTT,1)
- IF '$DATA(BGPDX(D))
- SET BGPDX(D)=""
- SET CNT=CNT+1
- SET H=1
- IF D>$$FMADD^XLFDT(EDATE,-365)
- SET B=1
- End DoDot:2
- +41 IF H
- QUIT
- +42 ;NOW PROCEDURES
- +43 SET Y=0
- SET H=""
- FOR
- SET Y=$ORDER(^AUPNVPRC("AD",VIEN,Y))
- IF Y'=+Y
- QUIT
- Begin DoDot:2
- +44 SET %=+^AUPNVPRC(Y,0)
- +45 IF $$ICD^BGP7UTL2(%,PXT,0)
- IF '$DATA(BGPDX(D))
- SET BGPDX(D)=""
- SET CNT=CNT+1
- SET H=1
- IF D>$$FMADD^XLFDT(EDATE,-365)
- SET B=1
- End DoDot:2
- +46 IF H
- QUIT
- +47 QUIT
- End DoDot:1
- +48 IF CNT>1
- IF B
- Begin DoDot:1
- +49 ;SET BGPD TO SECOND VISIT DATE
- +50 SET X=0
- SET C=0
- FOR
- SET X=$ORDER(BGPDX(X))
- IF X'=+X!(C>1)
- QUIT
- SET C=C+1
- IF C=2
- SET BGPD=X
- End DoDot:1
- GOTO MA
- +51 ;
- PROB ;
- +1 ;no pregnancy visit during time period ;-Lori fix in 09
- IF '$GET(B)
- QUIT ""
- +2 SET T=$ORDER(^ATXAX("B","BGP PREGNANCY DIAGNOSES 2",0))
- +3 SET (X,G)=0
- FOR
- SET X=$ORDER(^AUPNPROB("AC",P,X))
- IF X'=+X!(G)
- QUIT
- Begin DoDot:1
- +4 IF $PIECE(^AUPNPROB(X,0),U,12)="D"
- QUIT
- +5 IF $PIECE(^AUPNPROB(X,0),U,12)="I"
- QUIT
- +6 IF $PIECE(^AUPNPROB(X,0),U,8)>EDATE
- QUIT
- +7 IF $PIECE(^AUPNPROB(X,0),U,8)<BDATE
- QUIT
- +8 SET Y=$PIECE(^AUPNPROB(X,0),U)
- +9 IF '$$ICD^BGP7UTL2(Y,T,9)
- QUIT
- +10 SET G=$PIECE(^AUPNPROB(X,0),U,8)
- +11 QUIT
- End DoDot:1
- +12 IF G=0
- IF BGPD=""
- QUIT 0
- +13 SET BGPD=G
- MA ;now check for abortion or miscarriage
- +1 KILL BGPG
- SET Y="BGPG("
- SET X=P_"^LAST DX [BGP MISCARRIAGE/ABORTION DXS;DURING "_$$FMTE^XLFDT(BGPD)_"-"_$$FMTE^XLFDT(EDATE)
- SET E=$$START1^APCLDF(X,Y)
- +2 ;HAD MIS/AB
- IF $DATA(BGPG(1))
- QUIT 0
- +3 SET BGPG=$$LASTPRC^BGP7UTL1(P,"BGP ABORTION PROCEDURES",BGPD,EDATE)
- +4 IF BGPG
- QUIT 0
- +5 SET T=$ORDER(^ATXAX("B","BGP MISCARRIAGE/ABORTION DXS",0))
- +6 SET (X,G)=0
- FOR
- SET X=$ORDER(^AUPNPROB("AC",P,X))
- IF X'=+X!(G)
- QUIT
- Begin DoDot:1
- +7 IF $PIECE(^AUPNPROB(X,0),U,12)="D"
- QUIT
- +8 IF $PIECE(^AUPNPROB(X,0),U,12)="I"
- QUIT
- +9 IF $PIECE(^AUPNPROB(X,0),U,8)<BGPD
- QUIT
- +10 IF $PIECE(^AUPNPROB(X,0),U,8)>EDATE
- QUIT
- +11 SET Y=$PIECE(^AUPNPROB(X,0),U)
- +12 IF '$$ICD^BGP7UTL2(Y,T,9)
- QUIT
- +13 SET G=1
- +14 QUIT
- End DoDot:1
- +15 IF G
- QUIT 0
- +16 ;now check CPTs for Abortion and Miscarriage
- +17 SET T=$ORDER(^ATXAX("B","BGP CPT ABORTION",0))
- +18 SET %=$$CPT^BGP7DU(P,BGPD,EDATE,T,3)
- +19 IF %]""
- QUIT 0
- +20 SET T=$ORDER(^ATXAX("B","BGP CPT MISCARRIAGE",0))
- +21 SET %=$$CPT^BGP7DU(P,BGPD,EDATE,T,3)
- +22 IF %]""
- QUIT 0
- +23 SET T=$ORDER(^ATXAX("B","BGP CPT ABORTION",0))
- +24 SET %=$$TRAN^BGP7DU(P,BGPD,EDATE,T,3)
- +25 IF %]""
- QUIT 0
- +26 SET T=$ORDER(^ATXAX("B","BGP CPT MISCARRIAGE",0))
- +27 SET %=$$TRAN^BGP7DU(P,BGPD,EDATE,T,3)
- +28 IF %]""
- QUIT 0
- +29 IF FORM=""
- QUIT 1
- +30 QUIT 1_U_$$DATE^BGP7UTL(BGPD)
