APCLSIL1 ;IHS/CMI/LAB - ILI SURVEILLANCE;
;;3.0;IHS PCC REPORTS;**24,25,26,27,28,29,30,31**;FEB 05, 1997;Build 32
;
WT(V) ;EP - get last wt
NEW X,Y,Z
S Y=""
S X=0 F S X=$O(^AUPNVMSR("AD",V,X)) Q:X'=+X D
.Q:$P($G(^AUPNVMSR(X,2)),U,1) ;ENTERED IN ERROR
.Q:$$VAL^XBDIQ1(9000010.01,X,.01)'="WT"
.S Y=$P(^AUPNVMSR(X,0),U,4)
Q Y
HT(V) ;EP - get last wt
NEW X,Y,Z
S Y=""
S X=0 F S X=$O(^AUPNVMSR("AD",V,X)) Q:X'=+X D
.Q:$P($G(^AUPNVMSR(X,2)),U,1) ;ENTERED IN ERROR
.Q:$$VAL^XBDIQ1(9000010.01,X,.01)'="HT"
.S Y=$P(^AUPNVMSR(X,0),U,4)
Q Y
HASADVN6(APCLV) ;EP - PATCH 27 - if return 1 then count visit and put pieces 2 through n in columns 66 through 75
NEW X,P,Y,Z,APCLCLIN,T,G,C,D,CLNTAX,E
S CLNTAX=$O(^ATXAX("B","SURVEILLANCE ILI CLINICS",0))
I "AORSH"'[$P(^AUPNVSIT(APCLV,0),U,7) Q ""
S APCLCLIN=$$CLINIC^APCLV(APCLV,"I") ;get clinic code
;is there a PHN
S X=0,P=0 F S X=$O(^AUPNVPRV("AD",APCLV,X)) Q:X'=+X!(P) D
.Q:'$D(^AUPNVPRV(X,0))
.S Y=$P(^AUPNVPRV(X,0),U)
.S Z=$$VALI^XBDIQ1(200,Y,53.5)
.Q:'Z
.I $P($G(^DIC(7,Z,9999999)),U,1)=13 S P=1
I P G HASADN61
I $P(^AUPNVSIT(APCLV,0),U,7)'="H" I APCLCLIN="" Q ""
I $P(^AUPNVSIT(APCLV,0),U,7)'="H" I '$D(^ATXAX(CLNTAX,21,"B",APCLCLIN)) Q "" ;not in clinic taxonomy
HASADN61 ;
S G=0,D="",E=""
S C=0,P1=0,P2=0
S X=0 F S X=$O(^AUPNVPOV("AD",APCLV,X)) Q:X'=+X!(C>4) D
.S T=$P(^AUPNVPOV(X,0),U)
.I $$ICD^APCLSILU(T,$O(^ATXAX("B","SURVEILLANCE ADV EVENTS DXS",0)),9) D SET6 Q
.I $$ICD^APCLSILU(T,$O(^ATXAX("B","SURVEILLANCE ADV EVENTS LIVE",0)),9) D Q
..S A=$$AGE^APCLSILU(DFN,2,$$VD^APCLV(APCLV))
..Q:A<24
..Q:A>59
..D SET6
..Q
.I $$ICD^APCLSILU(T,$O(^ATXAX("B","SURVEILLANCE ADV EVENT FEBRILE",0)),9) D Q
..S A=$$AGE^APCLSILU(DFN,2,$$VD^APCLV(APCLV))
..Q:A>59
..D SET6
I 'C Q "" ;no diagnosis
Q 1_U_D_U_E
SET6 ;
S C=C+1,P1=P1+1,P2=P2+1
S $P(D,",",P1)=$$VAL^XBDIQ1(9000010.07,X,.01)
S $P(E,",",P1)=$$VD^APCLV(APCLV)
Q
OTHVAC(P,VD) ;EP - get all vaccine history up to this visit date
NEW C,X,Y,V,G,Z,R,P1,P2
S R="",X=0,G=0
S C=0,P1=-1,P2=0
F S X=$O(^AUPNVIMM("AC",P,X)) Q:X'=+X!(C>34) D
.Q:'$D(^AUPNVIMM(X,0))
.S V=$$VD^APCLV($P(^AUPNVIMM(X,0),U,3))
.;Q:V<3100801
.Q:V>VD
.S Y=$P($G(^AUPNVIMM(X,0)),U)
.Q:'Y
.Q:'$D(^AUTTIMM(Y,0))
.S Z=$P(^AUTTIMM(Y,0),U,3)
.S C=C+1,P1=P1+2,P2=P2+2
.S $P(R,",",P1)=Z
.S $P(R,",",P2)=V
.Q
Q R
PN(P,V) ;EP
I $P(^DPT(P,0),U,2)'="F" Q ""
NEW T,X,Y,Q,ED,BD,APCL,LPD,%,G
S ED=$$VD^APCLV(V)
S BD=$$FMADD^XLFDT(ED,-60)
S G=""
S T=$O(^ATXAX("B","SURVEILLANCE H1N1 PREGNANCY DX",0))
D ALLV^APCLAPIU(P,BD,ED,"APCL")
I '$D(APCL) Q ""
;now get rid of non-amb, non-H visits, and those whose primary dx is not asthma
NEW APCLJ
S X=0 F S X=$O(APCL(X)) Q:X'=+X D
.S V=$P(APCL(X),U,5)
.Q:'$D(^AUPNVSIT(V,0))
.Q:"AORSHI"'[$P(^AUPNVSIT(V,0),U,7)
.S (G,Y)=0 F S Y=$O(^AUPNVPOV("AD",V,Y)) Q:Y'=+Y!(G) D
..S Q=$P($G(^AUPNVPOV(Y,0)),U)
..Q:Q=""
..Q:'$$ICD^APCLSILU(Q,T,9) ;not in taxonomy
..S G=1
..S APCLJ(9999999-$P(APCL(X),U,1))=$P(APCL(X),U,1) ;set by date to eliminate 2 on same day
.Q
S LPD=$O(APCLJ(0))
I LPD="" Q ""
S LPD=9999999-LPD ;date of prenatal dx, find miscarriage, abortion or delivery between this date and ED
NEW APCLF
S APCLF=""
;check abortion / misc dxs
K APCL S X=P_"^LAST DX [BGP MISCARRIAGE/ABORTION DXS;DURING "_LPD_"-"_ED S E=$$START1^APCLDF(X,"APCL(")
I $D(APCL) Q "" ;FOUND SO NOT PREG ANYMORE
;K APCL S X=P_"^LAST PROC [BGP ABORTION PROCEDURES;DURING "_LPD_"-"_ED S E=$$START1^APCLDF(X,"APCL(")
K APCL S APCL=$$LASTPRCT^APCLSILU(P,LPD,ED,"BGP ABORTION PROCEDURES","D")
I APCL Q "" ;FOUND SO NOT PREG ANYMORE
;now check CPTs for Abortion and Miscarriage
S %=$$LASTCPTT^APCLAPIU(P,LPD,ED,"BGP CPT ABORTION","D")
I %]"" Q ""
S %=$$LASTCPTT^APCLAPIU(P,LPD,ED,"BGP CPT MISCARRIAGE","D")
I %]"" Q ""
K APCL S X=P_"^LAST DX [SURVEILLANCE H1N1 DELIVERY DX;DURING "_LPD_"-"_ED S E=$$START1^APCLDF(X,"APCL(")
I $D(APCL) Q "" ;FOUND SO NOT PREG ANYMORE
;K APCL S X=P_"^LAST PROC [SURVEILLANCE H1N1 DEL PROC;DURING "_LPD_"-"_ED S E=$$START1^APCLDF(X,"APCL(")
K APCL S APCL=$$LASTPRCT^APCLSILU(P,LPD,ED,"SURVEILLANCE H1N1 DEL PROC","D")
I APCL Q "" ;FOUND SO NOT PREG ANYMORE
;now check CPTs for Abortion and Miscarriage
S %=$$LASTCPTT^APCLAPIU(P,LPD,ED,"SURVEILLANCE H1N1 DELIVERY CPT","D")
I %]"" Q ""
Q "Y"
MONUP ;EP
K APCLUP,APCLAC
S APCLBD=$$FMADD^XLFDT(DT,-(3*365))
S APCLCHS=$P(^BGPSITE(DUZ(2),0),U,6)
S APCLFITI=$P(^BGPSITE(DUZ(2),0),U,9)
S APCLDFN=0 F S APCLDFN=$O(^AUPNPAT(APCLDFN)) Q:APCLDFN'=+APCLDFN D
.Q:'$D(^DPT(APCLDFN,0))
.Q:$P(^DPT(APCLDFN,0),U)["DEMO,PATIENT"
.Q:$$DEMO^APCLUTL(APCLDFN,"E")
.Q:$P(^DPT(APCLDFN,0),U,19) ;merged away
.Q:$P($G(^AUPNPAT(APCLDFN,-9)),U)
.;S G=0,X=0 F S X=$O(^BGPSITE(X)) Q:X'=+X I $P($G(^BGPSITE(X,0)),U,12) I $D(^DIBT($P(^BGPSITE(X,0),U,12),1,APCLDFN)) S G=1
.;Q:G
.S APCLACUP=0,APCLACCL=0
.;S APCLX=0 F S APCLX=$O(^BGPSITE(APCLX)) Q:APCLX'=+APCLX!(APCLACUP) S APCLACUP=$$ACTUP(APCLDFN,APCLBD,DT,$P(^BGPSITE(APCLX,0),U,5),1)
.S APCLACUP=$$ACTUP(APCLDFN,APCLBD,DT)
.Q:'APCLACUP
.S APCLAGE=$$AGE^AUPNPAT(APCLDFN,DT)
.I APCLAGE=0 S X=$$FMDIFF^XLFDT(DT,$P(^DPT(APCLDFN,0),U,3)),X=X\30.5,X=$P(X,".",1) D
..I X<6 S APCLAGE="0-5 months" Q
..S APCLAGE="6-11 months"
.;APCLUP(APCLAGE)=TOT UP^TOT UP ASTHMA^TOT UP DM^TOT UP PREG
.S $P(APCLUP(APCLAGE),U,1)=$P($G(APCLUP(APCLAGE)),U,1)+1
.S (APCLDM,APCLAST,APCLPREG)=0 ;set all flags to 0
.S APCLDM=$$ASTDM^APCLSIL2(APCLDFN,DT)
.S APCLAST=$P(APCLDM,U)
.S APCLDM=$P(APCLDM,U,2)
.S APCLPREG=$$PNM(APCLDFN,DT)
.I APCLAST="Y" S $P(APCLUP(APCLAGE),U,2)=$P($G(APCLUP(APCLAGE)),U,2)+1
.I APCLDM="Y" S $P(APCLUP(APCLAGE),U,3)=$P($G(APCLUP(APCLAGE)),U,3)+1
.I APCLPREG="Y" S $P(APCLUP(APCLAGE),U,4)=$P($G(APCLUP(APCLAGE)),U,4)+1
.S APCLACCL=$$ACTCL(APCLDFN,APCLBD,DT,APCLCHS)
.Q:'APCLACCL
.S $P(APCLAC(APCLAGE),U,1)=$P($G(APCLAC(APCLAGE)),U,1)+1
.I APCLAST="Y" S $P(APCLAC(APCLAGE),U,2)=$P($G(APCLAC(APCLAGE)),U,2)+1
.I APCLDM="Y" S $P(APCLAC(APCLAGE),U,3)=$P($G(APCLAC(APCLAGE)),U,3)+1
.I APCLPREG="Y" S $P(APCLAC(APCLAGE),U,4)=$P($G(APCLAC(APCLAGE)),U,4)+1
.Q
;FIND HIGHEST AGE
S H="",X="" F S X=$O(APCLUP(X)) Q:X'=+X S H=X
I '$D(APCLUP("0-5 months")) S APCLUP("0-5 months")="0^0^0^0"
I '$D(APCLUP("6-11 months")) S APCLUP("6-11 months")="0^0^0^0"
I '$D(APCLAC("0-5 months")) S APCLAC("0-5 months")="0^0^0^0"
I '$D(APCLAC("6-11 months")) S APCLAC("6-11 months")="0^0^0^0"
F X=1:1:H D
.I '$D(APCLUP(X)) S APCLUP(X)="0^0^0^0"
.I '$D(APCLAC(X)) S APCLAC(X)="0^0^0^0"
;write out file using xbgsave
K ^APCLDATA($J)
;
S C=1,^APCLDATA($J,C)="0-5 months"_","_+$P(APCLUP("0-5 months"),U,1)_","_+$P(APCLAC("0-5 months"),U,1) D
.F P=2:1:4 S ^APCLDATA($J,C)=^APCLDATA($J,C)_","_+$P(APCLUP("0-5 months"),U,P)
.F P=2:1:4 S ^APCLDATA($J,C)=^APCLDATA($J,C)_","_+$P(APCLAC("0-5 months"),U,P)
;
S C=2,^APCLDATA($J,C)="6-11 months"_","_+$P(APCLUP("6-11 months"),U,1)_","_+$P(APCLAC("6-11 months"),U,1) D
.F P=2:1:4 S ^APCLDATA($J,C)=^APCLDATA($J,C)_","_+$P(APCLUP("6-11 months"),U,P)
.F P=2:1:4 S ^APCLDATA($J,C)=^APCLDATA($J,C)_","_+$P(APCLAC("6-11 months"),U,P)
;
K APCLUP("0-5 months"),APCLUP("6-11 months"),APCLAC("0-5 months"),APCLAC("6-11 months")
;
S X=0,C=2 F S X=$O(APCLUP(X)) Q:X="" S C=C+1,^APCLDATA($J,C)=X_","_+$P(APCLUP(X),U,1)_","_+$P(APCLAC(X),U,1) D
.F P=2:1:4 S ^APCLDATA($J,C)=^APCLDATA($J,C)_","_+$P(APCLUP(X),U,P)
.F P=2:1:4 S ^APCLDATA($J,C)=^APCLDATA($J,C)_","_+$P(APCLAC(X),U,P)
;
S ^APCLDATA($J,0)=$P($G(^AUTTLOC(DUZ(2),1)),U,3)_","_(C+1) ;COUNTS HEADER RECORD
N XBGL,XBQ,XBQTO,XBNAR,XBMED,XBFLT,XBUF,XBFN
S XBGL="APCLDATA",XBMED="F",XBQ="N",XBFLT=1,XBF=$J,XBE=$J
S XBNAR="ILI SURVEILLANCE EXPORT-POPULATION"
S APCLASU=$P($G(^AUTTLOC($P(^AUTTSITE(1,0),U),0)),U,10) ;asufac for file name
;S XBFN="FLUPOP_"_APCLASU_"_"_$$DATE^APCLSILI(DT)_".txt"
NEW TST
S TST=0
;I '$$PROD^XUPROD() S TST=1
I $P($G(^APCLILIC(1,0)),U,5)="T" S TST=1
S (XBFN,APCLDFN)=$S(TST:"FLZPOP",$G(APCLFLF):"FLFPOP",$G(APCLFLFN):"FLZPOP",1:"FLUPOP")_"_"_APCLASU_"_"_$$DATE^APCLSILI(DT)_"_P31.txt" ;IHS/CMI/LAB - PATCH 31 FILENAME AND PATCH #
S XBS1="SURVEILLANCE ILI SEND"
;
D ^XBGSAVE
;
I XBFLG'=0 D
. I XBFLG(1)="" W:'$D(ZTQUEUED) !!,"VISIT ILI file successfully created",!!
. I XBFLG(1)]"" W:'$D(ZTQUEUED) !!,"VISIT ILI file NOT successfully created",!!
. W:'$D(ZTQUEUED) !,"File was NOT successfully transferred to IHS/CDC",!,"you will need to manually ftp it.",!
. W:'$D(ZTQUEUED) !,XBFLG(1),!!
K ^APCLDATA($J)
Q
ACTUP(P,BDATE,EDATE) ;EP - is this patient in user pop?
S X=$$LASTVD(P,BDATE,EDATE)
Q $S(X:1,1:0)
;
ACTCL(P,BDATE,EDATE,CHS) ;EP - clinical user
I CHS G CHSACTCL
NEW APCLYR
S APCLYR=$$GPRAIEN()
S (X,G,F,S)=0 F S X=$O(^TMP($J,"A",X)) Q:X'=+X!(F) S V=$P(^TMP($J,"A",X),U,5) D
.Q:'$D(^AUPNVSIT(V,0))
.Q:'$P(^AUPNVSIT(V,0),U,9)
.Q:$P(^AUPNVSIT(V,0),U,11)
.Q:'$D(^AUPNVPRV("AD",V))
.Q:"SAHO"'[$P(^AUPNVSIT(V,0),U,7)
.Q:"V"[$P(^AUPNVSIT(V,0),U,3)
.Q:$P(^AUPNVSIT(V,0),U,6)=""
.I $G(APCLFITI),'$D(^ATXAX(APCLFITI,21,"B",$P(^AUPNVSIT(V,0),U,6))) Q
.S B=$$CLINIC^APCLV(V,"C")
.Q:B=""
.I 'G,$D(^BGPCTRL(APCLYR,11,"B",B)) S G=V ;must be a primary clinic S G=V
.I V'=G,$D(^BGPCTRL(APCLYR,12,"B",B)) S S=1
.I G,S S F=1
.Q
Q $S(F:1,1:0)
;
GPRAIEN() ;EP
;---> Return GPRA Control File IEN
;
;---> Get the most recent GPRA Year Control file entry.
N APCLYR,APCLPIEN
S APCLYR=$O(^BGPCTRL("B",""),-1)
Q:'APCLYR 0
S APCLPIEN=$O(^BGPCTRL("B",APCLYR,0))
Q:'APCLPIEN 0
Q:('$G(^BGPCTRL(APCLPIEN,0))) 0
Q APCLPIEN
;
CHSACTCL ;chs only sites active clinical defintion
;2 chs visits in past 3 years
S (X,G,F,S)=0 F S X=$O(^TMP($J,"A",X)) Q:X'=+X!(F>1) S V=$P(^TMP($J,"A",X),U,5) D
.Q:'$D(^AUPNVSIT(V,0))
.Q:'$P(^AUPNVSIT(V,0),U,9)
.Q:$P(^AUPNVSIT(V,0),U,11)
.Q:'$D(^AUPNVPRV("AD",V))
.Q:"SAHOI"'[$P(^AUPNVSIT(V,0),U,7)
.Q:"C"'[$P(^AUPNVSIT(V,0),U,3)
.S F=F+1
Q $S(F>1:1,1:0)
;
LASTVD(P,BDATE,EDATE) ;
I '$D(^AUPNVSIT("AC",P)) Q ""
K ^TMP($J,"A")
S A="^TMP($J,""A"",",B=P_"^ALL VISITS;DURING "_$$FMTE^XLFDT(BDATE)_"-"_$$FMTE^XLFDT(EDATE),E=$$START1^APCLDF(B,A)
I '$D(^TMP($J,"A",1)) Q ""
S (X,G)=0 F S X=$O(^TMP($J,"A",X)) Q:X'=+X!(G) S V=$P(^TMP($J,"A",X),U,5) D
.Q:'$D(^AUPNVSIT(V,0))
.Q:'$P(^AUPNVSIT(V,0),U,9)
.Q:$P(^AUPNVSIT(V,0),U,11)
.Q:'$D(^AUPNVPRV("AD",V))
.Q:"SAHO"'[$P(^AUPNVSIT(V,0),U,7)
.Q:"V"[$P(^AUPNVSIT(V,0),U,3)
.Q:$P(^AUPNVSIT(V,0),U,6)=""
.I $G(APCLFITI),'$D(^ATXAX(APCLFITI,21,"B",$P(^AUPNVSIT(V,0),U,6))) Q
.S G=1
.Q
Q G
;
PNM(P,ED) ;EP
I $P(^DPT(P,0),U,2)'="F" Q ""
NEW T,X,Y,Q,BD,APCL,LPD,%,G
S BD=$$FMADD^XLFDT(ED,-60)
S G=""
S T=$O(^ATXAX("B","SURVEILLANCE H1N1 PREGNANCY DX",0))
D ALLV^APCLAPIU(P,BD,ED,"APCL")
I '$D(APCL) Q ""
;now get rid of non-amb, non-H visits, and those whose primary dx is not asthma
NEW APCLJ
S X=0 F S X=$O(APCL(X)) Q:X'=+X D
.S V=$P(APCL(X),U,5)
.Q:'$D(^AUPNVSIT(V,0))
.Q:"AORSHI"'[$P(^AUPNVSIT(V,0),U,7)
.S (G,Y)=0 F S Y=$O(^AUPNVPOV("AD",V,Y)) Q:Y'=+Y!(G) D
..S Q=$P($G(^AUPNVPOV(Y,0)),U)
..Q:Q=""
..Q:'$$ICD^APCLSILU(Q,T,9) ;not in taxonomy
..S G=1
..S APCLJ(9999999-$P(APCL(X),U,1))=$P(APCL(X),U,1) ;set by date to eliminate 2 on same day
.Q
S LPD=$O(APCLJ(0))
I LPD="" Q ""
S LPD=9999999-LPD ;date of prenatal dx, find miscarriage, abortion or delivery between this date and ED
NEW APCLF
S APCLF=""
;check abortion / misc dxs
K APCL S X=P_"^LAST DX [BGP MISCARRIAGE/ABORTION DXS;DURING "_LPD_"-"_ED S E=$$START1^APCLDF(X,"APCL(")
I $D(APCL) Q "" ;FOUND SO NOT PREG ANYMORE
K APCL S APCL=$$LASTPRCT^APCLSILU(P,LPD,ED,"BGP ABORTION PROCEDURES","D")
I APCL Q "" ;FOUND SO NOT PREG ANYMORE
;now check CPTs for Abortion and Miscarriage
S %=$$LASTCPTT^APCLAPIU(P,LPD,ED,"BGP CPT ABORTION","D")
I %]"" Q ""
S %=$$LASTCPTT^APCLAPIU(P,LPD,ED,"BGP CPT MISCARRIAGE","D")
I %]"" Q ""
K APCL S X=P_"^LAST DX [SURVEILLANCE H1N1 DELIVERY DX;DURING "_LPD_"-"_ED S E=$$START1^APCLDF(X,"APCL(")
I $D(APCL) Q "" ;FOUND SO NOT PREG ANYMORE
;K APCL S X=P_"^LAST PROC [SURVEILLANCE H1N1 DEL PROC;DURING "_LPD_"-"_ED S E=$$START1^APCLDF(X,"APCL(")
K APCL S APCL=$$LASTPRCT^APCLSILU(P,LPD,ED,"SURVEILLANCE H1N1 DEL PROC","D")
I APCL Q "" ;FOUND SO NOT PREG ANYMORE
;now check CPTs for Abortion and Miscarriage
S %=$$LASTCPTT^APCLAPIU(P,LPD,ED,"SURVEILLANCE H1N1 DELIVERY CPT","D")
I %]"" Q ""
Q "Y"
APCLSIL1 ;IHS/CMI/LAB - ILI SURVEILLANCE;
+1 ;;3.0;IHS PCC REPORTS;**24,25,26,27,28,29,30,31**;FEB 05, 1997;Build 32
+2 ;
WT(V) ;EP - get last wt
+1 NEW X,Y,Z
+2 SET Y=""
+3 SET X=0
FOR
SET X=$ORDER(^AUPNVMSR("AD",V,X))
IF X'=+X
QUIT
Begin DoDot:1
+4 ;ENTERED IN ERROR
IF $PIECE($GET(^AUPNVMSR(X,2)),U,1)
QUIT
+5 IF $$VAL^XBDIQ1(9000010.01,X,.01)'="WT"
QUIT
+6 SET Y=$PIECE(^AUPNVMSR(X,0),U,4)
End DoDot:1
+7 QUIT Y
HT(V) ;EP - get last wt
+1 NEW X,Y,Z
+2 SET Y=""
+3 SET X=0
FOR
SET X=$ORDER(^AUPNVMSR("AD",V,X))
IF X'=+X
QUIT
Begin DoDot:1
+4 ;ENTERED IN ERROR
IF $PIECE($GET(^AUPNVMSR(X,2)),U,1)
QUIT
+5 IF $$VAL^XBDIQ1(9000010.01,X,.01)'="HT"
QUIT
+6 SET Y=$PIECE(^AUPNVMSR(X,0),U,4)
End DoDot:1
+7 QUIT Y
HASADVN6(APCLV) ;EP - PATCH 27 - if return 1 then count visit and put pieces 2 through n in columns 66 through 75
+1 NEW X,P,Y,Z,APCLCLIN,T,G,C,D,CLNTAX,E
+2 SET CLNTAX=$ORDER(^ATXAX("B","SURVEILLANCE ILI CLINICS",0))
+3 IF "AORSH"'[$PIECE(^AUPNVSIT(APCLV,0),U,7)
QUIT ""
+4 ;get clinic code
SET APCLCLIN=$$CLINIC^APCLV(APCLV,"I")
+5 ;is there a PHN
+6 SET X=0
SET P=0
FOR
SET X=$ORDER(^AUPNVPRV("AD",APCLV,X))
IF X'=+X!(P)
QUIT
Begin DoDot:1
+7 IF '$DATA(^AUPNVPRV(X,0))
QUIT
+8 SET Y=$PIECE(^AUPNVPRV(X,0),U)
+9 SET Z=$$VALI^XBDIQ1(200,Y,53.5)
+10 IF 'Z
QUIT
+11 IF $PIECE($GET(^DIC(7,Z,9999999)),U,1)=13
SET P=1
End DoDot:1
+12 IF P
GOTO HASADN61
+13 IF $PIECE(^AUPNVSIT(APCLV,0),U,7)'="H"
IF APCLCLIN=""
QUIT ""
+14 ;not in clinic taxonomy
IF $PIECE(^AUPNVSIT(APCLV,0),U,7)'="H"
IF '$DATA(^ATXAX(CLNTAX,21,"B",APCLCLIN))
QUIT ""
HASADN61 ;
+1 SET G=0
SET D=""
SET E=""
+2 SET C=0
SET P1=0
SET P2=0
+3 SET X=0
FOR
SET X=$ORDER(^AUPNVPOV("AD",APCLV,X))
IF X'=+X!(C>4)
QUIT
Begin DoDot:1
+4 SET T=$PIECE(^AUPNVPOV(X,0),U)
+5 IF $$ICD^APCLSILU(T,$ORDER(^ATXAX("B","SURVEILLANCE ADV EVENTS DXS",0)),9)
DO SET6
QUIT
+6 IF $$ICD^APCLSILU(T,$ORDER(^ATXAX("B","SURVEILLANCE ADV EVENTS LIVE",0)),9)
Begin DoDot:2
+7 SET A=$$AGE^APCLSILU(DFN,2,$$VD^APCLV(APCLV))
+8 IF A<24
QUIT
+9 IF A>59
QUIT
+10 DO SET6
+11 QUIT
End DoDot:2
QUIT
+12 IF $$ICD^APCLSILU(T,$ORDER(^ATXAX("B","SURVEILLANCE ADV EVENT FEBRILE",0)),9)
Begin DoDot:2
+13 SET A=$$AGE^APCLSILU(DFN,2,$$VD^APCLV(APCLV))
+14 IF A>59
QUIT
+15 DO SET6
End DoDot:2
QUIT
End DoDot:1
+16 ;no diagnosis
IF 'C
QUIT ""
+17 QUIT 1_U_D_U_E
SET6 ;
+1 SET C=C+1
SET P1=P1+1
SET P2=P2+1
+2 SET $PIECE(D,",",P1)=$$VAL^XBDIQ1(9000010.07,X,.01)
+3 SET $PIECE(E,",",P1)=$$VD^APCLV(APCLV)
+4 QUIT
OTHVAC(P,VD) ;EP - get all vaccine history up to this visit date
+1 NEW C,X,Y,V,G,Z,R,P1,P2
+2 SET R=""
SET X=0
SET G=0
+3 SET C=0
SET P1=-1
SET P2=0
+4 FOR
SET X=$ORDER(^AUPNVIMM("AC",P,X))
IF X'=+X!(C>34)
QUIT
Begin DoDot:1
+5 IF '$DATA(^AUPNVIMM(X,0))
QUIT
+6 SET V=$$VD^APCLV($PIECE(^AUPNVIMM(X,0),U,3))
+7 ;Q:V<3100801
+8 IF V>VD
QUIT
+9 SET Y=$PIECE($GET(^AUPNVIMM(X,0)),U)
+10 IF 'Y
QUIT
+11 IF '$DATA(^AUTTIMM(Y,0))
QUIT
+12 SET Z=$PIECE(^AUTTIMM(Y,0),U,3)
+13 SET C=C+1
SET P1=P1+2
SET P2=P2+2
+14 SET $PIECE(R,",",P1)=Z
+15 SET $PIECE(R,",",P2)=V
+16 QUIT
End DoDot:1
+17 QUIT R
PN(P,V) ;EP
+1 IF $PIECE(^DPT(P,0),U,2)'="F"
QUIT ""
+2 NEW T,X,Y,Q,ED,BD,APCL,LPD,%,G
+3 SET ED=$$VD^APCLV(V)
+4 SET BD=$$FMADD^XLFDT(ED,-60)
+5 SET G=""
+6 SET T=$ORDER(^ATXAX("B","SURVEILLANCE H1N1 PREGNANCY DX",0))
+7 DO ALLV^APCLAPIU(P,BD,ED,"APCL")
+8 IF '$DATA(APCL)
QUIT ""
+9 ;now get rid of non-amb, non-H visits, and those whose primary dx is not asthma
+10 NEW APCLJ
+11 SET X=0
FOR
SET X=$ORDER(APCL(X))
IF X'=+X
QUIT
Begin DoDot:1
+12 SET V=$PIECE(APCL(X),U,5)
+13 IF '$DATA(^AUPNVSIT(V,0))
QUIT
+14 IF "AORSHI"'[$PIECE(^AUPNVSIT(V,0),U,7)
QUIT
+15 SET (G,Y)=0
FOR
SET Y=$ORDER(^AUPNVPOV("AD",V,Y))
IF Y'=+Y!(G)
QUIT
Begin DoDot:2
+16 SET Q=$PIECE($GET(^AUPNVPOV(Y,0)),U)
+17 IF Q=""
QUIT
+18 ;not in taxonomy
IF '$$ICD^APCLSILU(Q,T,9)
QUIT
+19 SET G=1
+20 ;set by date to eliminate 2 on same day
SET APCLJ(9999999-$PIECE(APCL(X),U,1))=$PIECE(APCL(X),U,1)
End DoDot:2
+21 QUIT
End DoDot:1
+22 SET LPD=$ORDER(APCLJ(0))
+23 IF LPD=""
QUIT ""
+24 ;date of prenatal dx, find miscarriage, abortion or delivery between this date and ED
SET LPD=9999999-LPD
+25 NEW APCLF
+26 SET APCLF=""
+27 ;check abortion / misc dxs
+28 KILL APCL
SET X=P_"^LAST DX [BGP MISCARRIAGE/ABORTION DXS;DURING "_LPD_"-"_ED
SET E=$$START1^APCLDF(X,"APCL(")
+29 ;FOUND SO NOT PREG ANYMORE
IF $DATA(APCL)
QUIT ""
+30 ;K APCL S X=P_"^LAST PROC [BGP ABORTION PROCEDURES;DURING "_LPD_"-"_ED S E=$$START1^APCLDF(X,"APCL(")
+31 KILL APCL
SET APCL=$$LASTPRCT^APCLSILU(P,LPD,ED,"BGP ABORTION PROCEDURES","D")
+32 ;FOUND SO NOT PREG ANYMORE
IF APCL
QUIT ""
+33 ;now check CPTs for Abortion and Miscarriage
+34 SET %=$$LASTCPTT^APCLAPIU(P,LPD,ED,"BGP CPT ABORTION","D")
+35 IF %]""
QUIT ""
+36 SET %=$$LASTCPTT^APCLAPIU(P,LPD,ED,"BGP CPT MISCARRIAGE","D")
+37 IF %]""
QUIT ""
+38 KILL APCL
SET X=P_"^LAST DX [SURVEILLANCE H1N1 DELIVERY DX;DURING "_LPD_"-"_ED
SET E=$$START1^APCLDF(X,"APCL(")
+39 ;FOUND SO NOT PREG ANYMORE
IF $DATA(APCL)
QUIT ""
+40 ;K APCL S X=P_"^LAST PROC [SURVEILLANCE H1N1 DEL PROC;DURING "_LPD_"-"_ED S E=$$START1^APCLDF(X,"APCL(")
+41 KILL APCL
SET APCL=$$LASTPRCT^APCLSILU(P,LPD,ED,"SURVEILLANCE H1N1 DEL PROC","D")
+42 ;FOUND SO NOT PREG ANYMORE
IF APCL
QUIT ""
+43 ;now check CPTs for Abortion and Miscarriage
+44 SET %=$$LASTCPTT^APCLAPIU(P,LPD,ED,"SURVEILLANCE H1N1 DELIVERY CPT","D")
+45 IF %]""
QUIT ""
+46 QUIT "Y"
MONUP ;EP
+1 KILL APCLUP,APCLAC
+2 SET APCLBD=$$FMADD^XLFDT(DT,-(3*365))
+3 SET APCLCHS=$PIECE(^BGPSITE(DUZ(2),0),U,6)
+4 SET APCLFITI=$PIECE(^BGPSITE(DUZ(2),0),U,9)
+5 SET APCLDFN=0
FOR
SET APCLDFN=$ORDER(^AUPNPAT(APCLDFN))
IF APCLDFN'=+APCLDFN
QUIT
Begin DoDot:1
+6 IF '$DATA(^DPT(APCLDFN,0))
QUIT
+7 IF $PIECE(^DPT(APCLDFN,0),U)["DEMO,PATIENT"
QUIT
+8 IF $$DEMO^APCLUTL(APCLDFN,"E")
QUIT
+9 ;merged away
IF $PIECE(^DPT(APCLDFN,0),U,19)
QUIT
+10 IF $PIECE($GET(^AUPNPAT(APCLDFN,-9)),U)
QUIT
+11 ;S G=0,X=0 F S X=$O(^BGPSITE(X)) Q:X'=+X I $P($G(^BGPSITE(X,0)),U,12) I $D(^DIBT($P(^BGPSITE(X,0),U,12),1,APCLDFN)) S G=1
+12 ;Q:G
+13 SET APCLACUP=0
SET APCLACCL=0
+14 ;S APCLX=0 F S APCLX=$O(^BGPSITE(APCLX)) Q:APCLX'=+APCLX!(APCLACUP) S APCLACUP=$$ACTUP(APCLDFN,APCLBD,DT,$P(^BGPSITE(APCLX,0),U,5),1)
+15 SET APCLACUP=$$ACTUP(APCLDFN,APCLBD,DT)
+16 IF 'APCLACUP
QUIT
+17 SET APCLAGE=$$AGE^AUPNPAT(APCLDFN,DT)
+18 IF APCLAGE=0
SET X=$$FMDIFF^XLFDT(DT,$PIECE(^DPT(APCLDFN,0),U,3))
SET X=X\30.5
SET X=$PIECE(X,".",1)
Begin DoDot:2
+19 IF X<6
SET APCLAGE="0-5 months"
QUIT
+20 SET APCLAGE="6-11 months"
End DoDot:2
+21 ;APCLUP(APCLAGE)=TOT UP^TOT UP ASTHMA^TOT UP DM^TOT UP PREG
+22 SET $PIECE(APCLUP(APCLAGE),U,1)=$PIECE($GET(APCLUP(APCLAGE)),U,1)+1
+23 ;set all flags to 0
SET (APCLDM,APCLAST,APCLPREG)=0
+24 SET APCLDM=$$ASTDM^APCLSIL2(APCLDFN,DT)
+25 SET APCLAST=$PIECE(APCLDM,U)
+26 SET APCLDM=$PIECE(APCLDM,U,2)
+27 SET APCLPREG=$$PNM(APCLDFN,DT)
+28 IF APCLAST="Y"
SET $PIECE(APCLUP(APCLAGE),U,2)=$PIECE($GET(APCLUP(APCLAGE)),U,2)+1
+29 IF APCLDM="Y"
SET $PIECE(APCLUP(APCLAGE),U,3)=$PIECE($GET(APCLUP(APCLAGE)),U,3)+1
+30 IF APCLPREG="Y"
SET $PIECE(APCLUP(APCLAGE),U,4)=$PIECE($GET(APCLUP(APCLAGE)),U,4)+1
+31 SET APCLACCL=$$ACTCL(APCLDFN,APCLBD,DT,APCLCHS)
+32 IF 'APCLACCL
QUIT
+33 SET $PIECE(APCLAC(APCLAGE),U,1)=$PIECE($GET(APCLAC(APCLAGE)),U,1)+1
+34 IF APCLAST="Y"
SET $PIECE(APCLAC(APCLAGE),U,2)=$PIECE($GET(APCLAC(APCLAGE)),U,2)+1
+35 IF APCLDM="Y"
SET $PIECE(APCLAC(APCLAGE),U,3)=$PIECE($GET(APCLAC(APCLAGE)),U,3)+1
+36 IF APCLPREG="Y"
SET $PIECE(APCLAC(APCLAGE),U,4)=$PIECE($GET(APCLAC(APCLAGE)),U,4)+1
+37 QUIT
End DoDot:1
+38 ;FIND HIGHEST AGE
+39 SET H=""
SET X=""
FOR
SET X=$ORDER(APCLUP(X))
IF X'=+X
QUIT
SET H=X
+40 IF '$DATA(APCLUP("0-5 months"))
SET APCLUP("0-5 months")="0^0^0^0"
+41 IF '$DATA(APCLUP("6-11 months"))
SET APCLUP("6-11 months")="0^0^0^0"
+42 IF '$DATA(APCLAC("0-5 months"))
SET APCLAC("0-5 months")="0^0^0^0"
+43 IF '$DATA(APCLAC("6-11 months"))
SET APCLAC("6-11 months")="0^0^0^0"
+44 FOR X=1:1:H
Begin DoDot:1
+45 IF '$DATA(APCLUP(X))
SET APCLUP(X)="0^0^0^0"
+46 IF '$DATA(APCLAC(X))
SET APCLAC(X)="0^0^0^0"
End DoDot:1
+47 ;write out file using xbgsave
+48 KILL ^APCLDATA($JOB)
+49 ;
+50 SET C=1
SET ^APCLDATA($JOB,C)="0-5 months"_","_+$PIECE(APCLUP("0-5 months"),U,1)_","_+$PIECE(APCLAC("0-5 months"),U,1)
Begin DoDot:1
+51 FOR P=2:1:4
SET ^APCLDATA($JOB,C)=^APCLDATA($JOB,C)_","_+$PIECE(APCLUP("0-5 months"),U,P)
+52 FOR P=2:1:4
SET ^APCLDATA($JOB,C)=^APCLDATA($JOB,C)_","_+$PIECE(APCLAC("0-5 months"),U,P)
End DoDot:1
+53 ;
+54 SET C=2
SET ^APCLDATA($JOB,C)="6-11 months"_","_+$PIECE(APCLUP("6-11 months"),U,1)_","_+$PIECE(APCLAC("6-11 months"),U,1)
Begin DoDot:1
+55 FOR P=2:1:4
SET ^APCLDATA($JOB,C)=^APCLDATA($JOB,C)_","_+$PIECE(APCLUP("6-11 months"),U,P)
+56 FOR P=2:1:4
SET ^APCLDATA($JOB,C)=^APCLDATA($JOB,C)_","_+$PIECE(APCLAC("6-11 months"),U,P)
End DoDot:1
+57 ;
+58 KILL APCLUP("0-5 months"),APCLUP("6-11 months"),APCLAC("0-5 months"),APCLAC("6-11 months")
+59 ;
+60 SET X=0
SET C=2
FOR
SET X=$ORDER(APCLUP(X))
IF X=""
QUIT
SET C=C+1
SET ^APCLDATA($JOB,C)=X_","_+$PIECE(APCLUP(X),U,1)_","_+$PIECE(APCLAC(X),U,1)
Begin DoDot:1
+61 FOR P=2:1:4
SET ^APCLDATA($JOB,C)=^APCLDATA($JOB,C)_","_+$PIECE(APCLUP(X),U,P)
+62 FOR P=2:1:4
SET ^APCLDATA($JOB,C)=^APCLDATA($JOB,C)_","_+$PIECE(APCLAC(X),U,P)
End DoDot:1
+63 ;
+64 ;COUNTS HEADER RECORD
SET ^APCLDATA($JOB,0)=$PIECE($GET(^AUTTLOC(DUZ(2),1)),U,3)_","_(C+1)
+65 NEW XBGL,XBQ,XBQTO,XBNAR,XBMED,XBFLT,XBUF,XBFN
+66 SET XBGL="APCLDATA"
SET XBMED="F"
SET XBQ="N"
SET XBFLT=1
SET XBF=$JOB
SET XBE=$JOB
+67 SET XBNAR="ILI SURVEILLANCE EXPORT-POPULATION"
+68 ;asufac for file name
SET APCLASU=$PIECE($GET(^AUTTLOC($PIECE(^AUTTSITE(1,0),U),0)),U,10)
+69 ;S XBFN="FLUPOP_"_APCLASU_"_"_$$DATE^APCLSILI(DT)_".txt"
+70 NEW TST
+71 SET TST=0
+72 ;I '$$PROD^XUPROD() S TST=1
+73 IF $PIECE($GET(^APCLILIC(1,0)),U,5)="T"
SET TST=1
+74 ;IHS/CMI/LAB - PATCH 31 FILENAME AND PATCH #
SET (XBFN,APCLDFN)=$SELECT(TST:"FLZPOP",$GET(APCLFLF):"FLFPOP",$GET(APCLFLFN):"FLZPOP",1:"FLUPOP")_"_"_APCLASU_"_"_$$DATE^APCLSILI(DT)_"_P31.txt"
+75 SET XBS1="SURVEILLANCE ILI SEND"
+76 ;
+77 DO ^XBGSAVE
+78 ;
+79 IF XBFLG'=0
Begin DoDot:1
+80 IF XBFLG(1)=""
IF '$DATA(ZTQUEUED)
WRITE !!,"VISIT ILI file successfully created",!!
+81 IF XBFLG(1)]""
IF '$DATA(ZTQUEUED)
WRITE !!,"VISIT ILI file NOT successfully created",!!
+82 IF '$DATA(ZTQUEUED)
WRITE !,"File was NOT successfully transferred to IHS/CDC",!,"you will need to manually ftp it.",!
+83 IF '$DATA(ZTQUEUED)
WRITE !,XBFLG(1),!!
End DoDot:1
+84 KILL ^APCLDATA($JOB)
+85 QUIT
ACTUP(P,BDATE,EDATE) ;EP - is this patient in user pop?
+1 SET X=$$LASTVD(P,BDATE,EDATE)
+2 QUIT $SELECT(X:1,1:0)
+3 ;
ACTCL(P,BDATE,EDATE,CHS) ;EP - clinical user
+1 IF CHS
GOTO CHSACTCL
+2 NEW APCLYR
+3 SET APCLYR=$$GPRAIEN()
+4 SET (X,G,F,S)=0
FOR
SET X=$ORDER(^TMP($JOB,"A",X))
IF X'=+X!(F)
QUIT
SET V=$PIECE(^TMP($JOB,"A",X),U,5)
Begin DoDot:1
+5 IF '$DATA(^AUPNVSIT(V,0))
QUIT
+6 IF '$PIECE(^AUPNVSIT(V,0),U,9)
QUIT
+7 IF $PIECE(^AUPNVSIT(V,0),U,11)
QUIT
+8 IF '$DATA(^AUPNVPRV("AD",V))
QUIT
+9 IF "SAHO"'[$PIECE(^AUPNVSIT(V,0),U,7)
QUIT
+10 IF "V"[$PIECE(^AUPNVSIT(V,0),U,3)
QUIT
+11 IF $PIECE(^AUPNVSIT(V,0),U,6)=""
QUIT
+12 IF $GET(APCLFITI)
IF '$DATA(^ATXAX(APCLFITI,21,"B",$PIECE(^AUPNVSIT(V,0),U,6)))
QUIT
+13 SET B=$$CLINIC^APCLV(V,"C")
+14 IF B=""
QUIT
+15 ;must be a primary clinic S G=V
IF 'G
IF $DATA(^BGPCTRL(APCLYR,11,"B",B))
SET G=V
+16 IF V'=G
IF $DATA(^BGPCTRL(APCLYR,12,"B",B))
SET S=1
+17 IF G
IF S
SET F=1
+18 QUIT
End DoDot:1
+19 QUIT $SELECT(F:1,1:0)
+20 ;
GPRAIEN() ;EP
+1 ;---> Return GPRA Control File IEN
+2 ;
+3 ;---> Get the most recent GPRA Year Control file entry.
+4 NEW APCLYR,APCLPIEN
+5 SET APCLYR=$ORDER(^BGPCTRL("B",""),-1)
+6 IF 'APCLYR
QUIT 0
+7 SET APCLPIEN=$ORDER(^BGPCTRL("B",APCLYR,0))
+8 IF 'APCLPIEN
QUIT 0
+9 IF ('$GET(^BGPCTRL(APCLPIEN,0)))
QUIT 0
+10 QUIT APCLPIEN
+11 ;
CHSACTCL ;chs only sites active clinical defintion
+1 ;2 chs visits in past 3 years
+2 SET (X,G,F,S)=0
FOR
SET X=$ORDER(^TMP($JOB,"A",X))
IF X'=+X!(F>1)
QUIT
SET V=$PIECE(^TMP($JOB,"A",X),U,5)
Begin DoDot:1
+3 IF '$DATA(^AUPNVSIT(V,0))
QUIT
+4 IF '$PIECE(^AUPNVSIT(V,0),U,9)
QUIT
+5 IF $PIECE(^AUPNVSIT(V,0),U,11)
QUIT
+6 IF '$DATA(^AUPNVPRV("AD",V))
QUIT
+7 IF "SAHOI"'[$PIECE(^AUPNVSIT(V,0),U,7)
QUIT
+8 IF "C"'[$PIECE(^AUPNVSIT(V,0),U,3)
QUIT
+9 SET F=F+1
End DoDot:1
+10 QUIT $SELECT(F>1:1,1:0)
+11 ;
LASTVD(P,BDATE,EDATE) ;
+1 IF '$DATA(^AUPNVSIT("AC",P))
QUIT ""
+2 KILL ^TMP($JOB,"A")
+3 SET A="^TMP($J,""A"","
SET B=P_"^ALL VISITS;DURING "_$$FMTE^XLFDT(BDATE)_"-"_$$FMTE^XLFDT(EDATE)
SET E=$$START1^APCLDF(B,A)
+4 IF '$DATA(^TMP($JOB,"A",1))
QUIT ""
+5 SET (X,G)=0
FOR
SET X=$ORDER(^TMP($JOB,"A",X))
IF X'=+X!(G)
QUIT
SET V=$PIECE(^TMP($JOB,"A",X),U,5)
Begin DoDot:1
+6 IF '$DATA(^AUPNVSIT(V,0))
QUIT
+7 IF '$PIECE(^AUPNVSIT(V,0),U,9)
QUIT
+8 IF $PIECE(^AUPNVSIT(V,0),U,11)
QUIT
+9 IF '$DATA(^AUPNVPRV("AD",V))
QUIT
+10 IF "SAHO"'[$PIECE(^AUPNVSIT(V,0),U,7)
QUIT
+11 IF "V"[$PIECE(^AUPNVSIT(V,0),U,3)
QUIT
+12 IF $PIECE(^AUPNVSIT(V,0),U,6)=""
QUIT
+13 IF $GET(APCLFITI)
IF '$DATA(^ATXAX(APCLFITI,21,"B",$PIECE(^AUPNVSIT(V,0),U,6)))
QUIT
+14 SET G=1
+15 QUIT
End DoDot:1
+16 QUIT G
+17 ;
PNM(P,ED) ;EP
+1 IF $PIECE(^DPT(P,0),U,2)'="F"
QUIT ""
+2 NEW T,X,Y,Q,BD,APCL,LPD,%,G
+3 SET BD=$$FMADD^XLFDT(ED,-60)
+4 SET G=""
+5 SET T=$ORDER(^ATXAX("B","SURVEILLANCE H1N1 PREGNANCY DX",0))
+6 DO ALLV^APCLAPIU(P,BD,ED,"APCL")
+7 IF '$DATA(APCL)
QUIT ""
+8 ;now get rid of non-amb, non-H visits, and those whose primary dx is not asthma
+9 NEW APCLJ
+10 SET X=0
FOR
SET X=$ORDER(APCL(X))
IF X'=+X
QUIT
Begin DoDot:1
+11 SET V=$PIECE(APCL(X),U,5)
+12 IF '$DATA(^AUPNVSIT(V,0))
QUIT
+13 IF "AORSHI"'[$PIECE(^AUPNVSIT(V,0),U,7)
QUIT
+14 SET (G,Y)=0
FOR
SET Y=$ORDER(^AUPNVPOV("AD",V,Y))
IF Y'=+Y!(G)
QUIT
Begin DoDot:2
+15 SET Q=$PIECE($GET(^AUPNVPOV(Y,0)),U)
+16 IF Q=""
QUIT
+17 ;not in taxonomy
IF '$$ICD^APCLSILU(Q,T,9)
QUIT
+18 SET G=1
+19 ;set by date to eliminate 2 on same day
SET APCLJ(9999999-$PIECE(APCL(X),U,1))=$PIECE(APCL(X),U,1)
End DoDot:2
+20 QUIT
End DoDot:1
+21 SET LPD=$ORDER(APCLJ(0))
+22 IF LPD=""
QUIT ""
+23 ;date of prenatal dx, find miscarriage, abortion or delivery between this date and ED
SET LPD=9999999-LPD
+24 NEW APCLF
+25 SET APCLF=""
+26 ;check abortion / misc dxs
+27 KILL APCL
SET X=P_"^LAST DX [BGP MISCARRIAGE/ABORTION DXS;DURING "_LPD_"-"_ED
SET E=$$START1^APCLDF(X,"APCL(")
+28 ;FOUND SO NOT PREG ANYMORE
IF $DATA(APCL)
QUIT ""
+29 KILL APCL
SET APCL=$$LASTPRCT^APCLSILU(P,LPD,ED,"BGP ABORTION PROCEDURES","D")
+30 ;FOUND SO NOT PREG ANYMORE
IF APCL
QUIT ""
+31 ;now check CPTs for Abortion and Miscarriage
+32 SET %=$$LASTCPTT^APCLAPIU(P,LPD,ED,"BGP CPT ABORTION","D")
+33 IF %]""
QUIT ""
+34 SET %=$$LASTCPTT^APCLAPIU(P,LPD,ED,"BGP CPT MISCARRIAGE","D")
+35 IF %]""
QUIT ""
+36 KILL APCL
SET X=P_"^LAST DX [SURVEILLANCE H1N1 DELIVERY DX;DURING "_LPD_"-"_ED
SET E=$$START1^APCLDF(X,"APCL(")
+37 ;FOUND SO NOT PREG ANYMORE
IF $DATA(APCL)
QUIT ""
+38 ;K APCL S X=P_"^LAST PROC [SURVEILLANCE H1N1 DEL PROC;DURING "_LPD_"-"_ED S E=$$START1^APCLDF(X,"APCL(")
+39 KILL APCL
SET APCL=$$LASTPRCT^APCLSILU(P,LPD,ED,"SURVEILLANCE H1N1 DEL PROC","D")
+40 ;FOUND SO NOT PREG ANYMORE
IF APCL
QUIT ""
+41 ;now check CPTs for Abortion and Miscarriage
+42 SET %=$$LASTCPTT^APCLAPIU(P,LPD,ED,"SURVEILLANCE H1N1 DELIVERY CPT","D")
+43 IF %]""
QUIT ""
+44 QUIT "Y"
