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

APCHSM04.m

Go to the documentation of this file. 
APCHSM04 ; IHS/CMI/LAB -- CONTINUATION OF ROUTINES  ; 

 ;;2.0;IHS PCC SUITE;**2,7,11,16**;MAY 14, 2009;Build 9

 ;

S(X) ;

 NEW %,C S (C,%)=0 F  S %=$O(APCHSTEX(%)) Q:%'=+%  S C=C+1

 S APCHSTEX(C+1)=X

 Q

HT ;EP

 X APCHSURX

 Q:'$$INAC^APCHSMU(APCHSITI)

 S APCHLAST="",APCHNEXT="" K APCHSTEX

 S APCHICAR=$$LASTITEM^APCLAPIU(APCHSPAT,"HT","MEASUREMENT",,,"A")

 S APCHLAST=$P(APCHICAR,U,1)

 S APCHOVR=$$OVR^APCHSMU(APCHSPAT,APCHSITI)

 I $P(APCHOVR,U)>APCHLAST D  Q

 .S X=$$DATE^APCHSMU($P(APCHOVR,U))_" (per "_$P(APCHOVR,U,2)_")" D S(X) S X=$P(APCHOVR,U,3) D S(X)

 .D PRHT

HTREG ;

 S APCHSINT="",APCHSCRI=$$SITECRIT^APCHSMU(APCHSITI)

 I APCHSCRI S APCHSINT=$$AGESEX^APCHSMU(APCHSITI,APCHSPAT),APCHMIN=$$MINAGE^APCHSMU(APCHSITI,APCHSPAT)

 I 'APCHSCRI S APCHSINT=365,APCHMIN=0

 I APCHSINT="" X APCHSURX Q

 I 'APCHSCRI D IHSHT Q

HTREG1 ;

 I APCHLAST="" S APCHSTEX(1)=$$DATE^APCHSMU($$DATEAGE^APCHSMU(APCHSPAT,APCHMIN)) D PRHT Q

 S APCHNEXT=$$FMADD^XLFDT(APCHLAST,APCHSINT)

 I APCHNEXT>DT S APCHSTEX(1)=$$DATE^APCHSMU(APCHNEXT)

 I APCHNEXT'>DT S APCHSTEX(1)=$$DATE^APCHSMU(APCHNEXT)

 D PRHT

 Q

 ;

IHSHT ;

 I APCHLAST="" S APCHSTEX(1)=$$DATE^APCHSMU($$DATEAGE^APCHSMU(APCHSPAT,APCHMIN)) D PRHT Q

 I APCHSAGE>2,APCHSAGE<19 S APCHSINT=365 D HTREG1 Q

 I APCHSAGE>64 S APCHSINT=365 D HTREG1 Q

 I APCHSAGE>18,APCHSAGE<65 D  Q

 .S Y=$$FMADD^XLFDT(APCHSDOB,(18*365))

 .I Y<APCHLAST X APCHSURX Q

 .D HTREG1

 .Q

 S APCHDAYS=$$FMDIFF^XLFDT(DT,APCHSDOB)

 I APCHDAYS>0,APCHDAYS<(2*30.5) S APCHSTEX(1)=$$DATE^APCHSMU($$FMADD^XLFDT(APCHSDOB,(2*30.5))) D PRHT Q

 I APCHDAYS'<(2*30.5),APCHDAYS<(4*30.5) S APCHNEXT=$$FMADD^XLFDT(APCHSDOB,(4*30.5)),APCHLDUE=$$FMADD^XLFDT(APCHSDOB,(2*30.5)) D HTT Q

 I APCHDAYS'<(4*30.5),APCHDAYS<(6*30.5) S APCHNEXT=$$FMADD^XLFDT(APCHSDOB,(6*30.5)),APCHLDUE=$$FMADD^XLFDT(APCHSDOB,(4*30.5)) D HTT Q

 I APCHDAYS'<(6*30.5),APCHDAYS<365.25 S APCHNEXT=$$FMADD^XLFDT(APCHSDOB,365.25),APCHLDUE=$$FMADD^XLFDT(APCHSDOB,(6*30.5)) D HTT Q

 I APCHDAYS'<365,APCHDAYS<(18*30.5) S APCHNEXT=$$FMADD^XLFDT(APCHSDOB,(18*30.5)),APCHLDUE=$$FMADD^XLFDT(APCHSDOB,365) D HTT Q

 S APCHNEXT=$$FMADD^XLFDT(APCHSDOB,(2*365)),APCHLDUE=$$FMADD^XLFDT(APCHSDOB,(18*30.5)) D HTT Q

 Q

HTT ;

 I APCHLDUE>APCHLAST S APCHSTEX(1)=$$DATE^APCHSMU(APCHLDUE) D PRHT Q

 I APCHNEXT<DT S APCHSTEX(1)=$$DATE^APCHSMU(APCHNEXT) D PRHT Q

 I APCHNEXT'<DT S APCHSTEX(1)=$$DATE^APCHSMU(APCHNEXT) D PRHT Q

 Q

PRHT ;

 S V=$$REF^APCHSMU(APCHSPAT,9999999.07,$O(^AUTTMSR("B","HT",0)),APCHLAST) I V]"" S X=$P(V,U) D S(X) S X=$P(V,U,2) I X]"" D S(X)

 D WRITE^APCHSMU X APCHSURX

 Q

 ;

FLU ;EP - influenza

 I $E(DT,4,5)="05"!($E(DT,4,5)="06")!($E(DT,4,5)="07")!($E(DT,4,5)="08") Q  ;don't display in summer

 X APCHSURX

 Q:'$$INAC^APCHSMU(APCHSITI)

 S APCHSINT="",APCHSCRI=$$SITECRIT^APCHSMU(APCHSITI)

 I APCHSCRI S APCHSINT=$$AGESEX^APCHSMU(APCHSITI,APCHSPAT),APCHMIN=$$MINAGE^APCHSMU(APCHSITI,APCHSPAT)

 I 'APCHSCRI I $$FLUIHS(APCHSPAT) S APCHSINT=365,APCHMIN=64 I $$PLTAX^APCHSMU(APCHSPAT,"SURVEILLANCE PNEUMOCOCCAL RISK") S APCHMIN=$$AGE^AUPNPAT(APCHSPAT)

 S APCHLAST="",APCHNEXT="" K APCHSTEX

 S APCHSFLX=$S($$BI^APCHS11C:$O(^AUTTIMM("C",88,"")),1:$O(^AUTTIMM("C",12,""))),APCHIMMC=$S($$BI^APCHS11C:88,1:12)

 S APCHICAR=$$LASTFLU^APCLAPI4(APCHSPAT,,,"A")

 S APCHLAST=$P(APCHICAR,U,1)

 S APCHOVR=$$OVR^APCHSMU(APCHSPAT,APCHSITI)

 I $P(APCHOVR,U)>APCHLAST D  Q

 .S X=$$DATE^APCHSMU($P(APCHOVR,U))_" (per "_$P(APCHOVR,U,2)_")" D S(X) S X=$P(APCHOVR,U,3) D S(X)

 .S V="" F APCHSC=15,16,88,111 Q:V]""  S APCHSFLX=$O(^AUTTIMM("C",APCHSC,0)) D

 ..S V=$$REF^APCHSMU(APCHSPAT,9999999.14,APCHSFLX,APCHLAST) I V]"" S X=$P(V,U) D S(X) S X=$P(V,U,2) I X]"" D S(X)

 .D WRITE^APCHSMU

 .X APCHSURX

 .Q

FLUREG ;

 I APCHSINT="" X APCHSURX Q

 I APCHLAST="" S APCHSTEX(1)=$$DATE^APCHSMU($$DATEAGE^APCHSMU(APCHSPAT,APCHMIN)) D  Q

 .S V="" F APCHSC=15,16,88,111 Q:V]""  S APCHSFLX=$O(^AUTTIMM("C",APCHSC,0)) D

 ..S V=$$REF^APCHSMU(APCHSPAT,9999999.14,APCHSFLX,APCHLAST) I V]"" S X=$P(V,U) D S(X) S X=$P(V,U,2) I X]"" D S(X)

 .D WRITE^APCHSMU

 .X APCHSURX

 .Q

 S APCHNEXT=$$FMADD^XLFDT(APCHLAST,APCHSINT)

 I APCHNEXT>DT S APCHSTEX(1)=$$DATE^APCHSMU(APCHNEXT)

 I APCHNEXT'>DT S APCHSTEX(1)=$$DATE^APCHSMU(APCHNEXT)

 S V="" F APCHSC=15,16,88,111 Q:V]""  S APCHSFLX=$O(^AUTTIMM("C",APCHSC,0)) D

 .S V=$$REF^APCHSMU(APCHSPAT,9999999.14,APCHSFLX,APCHLAST) I V]"" S X=$P(V,U) D S(X) S X=$P(V,U,2) I X]"" D S(X)

 D WRITE^APCHSMU

 X APCHSURX

 Q

 ;

FLUIHS(P)  ;

 NEW %,S

 I '$G(P) Q ""

 I $$AGE^AUPNPAT(P,DT)>64 Q 1

 S %=$$FMDIFF^XLFDT(DT,$P(^DPT(P,0),U,3),1)

 I %<180 Q ""

 I $$PLTAX^APCHSMU(APCHSPAT,"SURVEILLANCE PNEUMOCOCCAL RISK") Q 1

 Q ""

MAMREF ;

 D MAMREF^APCHSMU2

 Q

MAMWT ;

 D MAMREF

 D WRITE^APCHSMU

 X APCHSURX

 Q

MAMM ;

 Q:'$$INAC^APCHSMU(APCHSITI)

 Q:APCHSEX'="F"

 S (APCHLAST,APCHNEXT,APCHWHL,APCHWHN,APCHSWHR,APCHICAR,APCHIC,APCHWF)="" K APCHSTEX,APCHX

 S APCHICAR=$$LASTMAM^APCLAPI1(APCHSPAT,,,"A"),APCHWF=$P(APCHICAR,U,5)

 S APCHLAST=$P(APCHICAR,U,1)

 D

 .S X="BWUTL1" X ^%ZOSF("TEST") I '$T Q

 .I '$D(^BWP(APCHSPAT,0)) Q

 .S APCHX=$$BNEED^BWUTL1(APCHSPAT)

 .I APCHX="UNKNOWN" K APCHX Q

 .I APCHX["NO DATE" K APCHX Q

 .S X=$P(APCHX,"by ",2),X=$P(X,")",1)

 .I $E(X)'?1N Q

 .S %DT="" D ^%DT

 .S APCHWHN=Y,APCHSWHR=APCHX

 ;now check against WH, if WH more current then check override, display and quit

 S I=0  ;USE WH OR NOT?

 I APCHWHN]"",APCHLAST]"",APCHLAST<APCHWHN S I=1

 I APCHWHN]"",APCHLAST="" S I=1  ;use wh if have a next and last =""

 I I D  Q

 .S APCHNEXT=APCHWHN

 .S APCHSTEX(1)=APCHX

 .S X="(per Women's Health system)" D S(X)

 .S APCHOVR=$$OVR^APCHSMU(APCHSPAT,APCHSITI)

 .I $P(APCHOVR,U)>APCHLAST D  Q

 ..S X=$$DATE^APCHSMU($P(APCHOVR,U))_" (per "_$P(APCHOVR,U,2)_")" D S(X) S X=$P(APCHOVR,U,3) D S(X)

 .D MAMWT

 .Q

MAMR ;NOW REGULAR OLD STUFF

 S APCHOVR=$$OVR^APCHSMU(APCHSPAT,APCHSITI)

 I $P(APCHOVR,U)>APCHLAST D  Q

 .S X=$$DATE^APCHSMU($P(APCHOVR,U))_" (per "_$P(APCHOVR,U,2)_")" D S(X) S X=$P(APCHOVR,U,3) D S(X)

 .D MAMWT

MAMREG ;regular stuff

 S APCHSINT="",APCHSCRI=$$SITECRIT^APCHSMU(APCHSITI)

 I 'APCHSCRI D

 .Q:APCHSAGE<50

 .Q:APCHSAGE>74

 .S APCHSINT=365

 .S APCHMIN=50

 I APCHSCRI S APCHSINT=$$AGESEX^APCHSMU(APCHSITI,APCHSPAT),APCHMIN=$$MINAGE^APCHSMU(APCHSITI,APCHSPAT) ;return in APCHSINT the frequency in days for this age/sex

 I APCHSINT="" X APCHSURX Q  ;no frequency so skip it

 I APCHLAST="" S APCHSTEX(1)=$$DATE^APCHSMU($$DATEAGE^APCHSMU(APCHSPAT,APCHMIN)) D  Q

 .D MAMWT

 S APCHNEXT=$$FMADD^XLFDT(APCHLAST,APCHSINT)

 I APCHNEXT>DT S APCHSTEX(1)=$$DATE^APCHSMU(APCHNEXT)

 I APCHNEXT'>DT S APCHSTEX(1)=$$DATE^APCHSMU(APCHNEXT)

 D MAMWT

 Q

PAPWT ;

 S APCHTAXN=$O(^ATXLAB("B","BGP PAP SMEAR TAX",0))

 D REF

 ;S V=$$REF^APCHSMU(APCHSPAT,60,$O(^LAB(60,"B","PAP SMEAR",0)),APCHLAST) I V]"" S X=$P(V,U) D S(X) S X=$P(V,U,2) I X]"" D S(X)

 D WRITE^APCHSMU

 X APCHSURX

 Q

REF ;

 K APCHREF S APCHT=0 F  S APCHT=$O(^ATXLAB(APCHTAXN,21,"B",APCHT)) Q:APCHT'=+APCHT  D

 .S V=$$REF^APCHSMU(APCHSPAT,60,APCHT,APCHLAST) I V]"" S APCHREF(9999999-$P(V,U,3))=V

 S V=$$REF^APCHSMU(APCHSPAT,60,$O(^LAB(60,"B","PAP SMEAR",0)),APCHLAST) I V]"" S APCHREF(9999999-$P(V,U,3))=V

 I $D(APCHREF) S %=0,%=$O(APCHREF(%)) I % S V=APCHREF(%),X=$P(V,U) D S(X) S X=$P(V,U,2) I X]"" D S(X)

 Q

PAP ;

 Q:'$$INAC^APCHSMU(APCHSITI)  ;is item turned on or off

 Q:APCHSEX'="F"  ;females only

 S (APCHLAST,APCHNEXT,APCHWHL,APCHWHN,APCHSWHR,APCHICAR,APCHIC,APCHWF,APCHHPV)="" K APCHSTEX,APCHX

 S APCHICAR=$$LASTPAP^APCLAPI1(APCHSPAT,,,"A")

 S APCHLAST=$P(APCHICAR,U,1),APCHWF=$P(APCHICAR,U,5)

 D

 .S X="BWUTL1" X ^%ZOSF("TEST") I '$T Q

 .I '$D(^BWP(APCHSPAT,0)) Q

 .S APCHX=$$CNEED^BWUTL1(APCHSPAT)

 .I APCHX="UNKNOWN" K APCHX Q

 .I APCHX["NO DATE" K APCHX Q

 .I APCHX'["PAP" S APCHWHN="",APCHSWHR=APCHX Q

 .S APCHY=""

 .I APCHX["by " D

 ..S X=$P(APCHX,"by ",2),X=$P(X,")",1)

 ..I $E(X)'?1N Q

 ..S %DT="" D ^%DT

 ..S APCHY=Y

 .S APCHWHN=APCHY,APCHSWHR=APCHX

 S APCHWHL=APCHLAST

 S I=1

 I APCHSWHR="" S I=0

 I APCHWHN]"",APCHLAST]"",APCHLAST<APCHWHN S I=1

 I I D  Q

 .S APCHLAST=APCHWHL,APCHNEXT=APCHWHN

 .S APCHSTEX(1)=APCHSWHR

 .S X="(per Women's Health system)" D S(X)

 .S APCHOVR=$$OVR^APCHSMU(APCHSPAT,APCHSITI)

 .I $P(APCHOVR,U)>APCHLAST D  Q

 ..S X=$$DATE^APCHSMU($P(APCHOVR,U))_" (per "_$P(APCHOVR,U,2)_")" D S(X) S X=$P(APCHOVR,U,3) D S(X)

 .D PAPWT

 .Q

 S APCHOVR=$$OVR^APCHSMU(APCHSPAT,APCHSITI)

 I $P(APCHOVR,U)>APCHLAST D  Q

 .S X=$$DATE^APCHSMU($P(APCHOVR,U))_" (per "_$P(APCHOVR,U,2)_")" D S(X) S X=$P(APCHOVR,U,3) D S(X)

 .D PAPWT

PAPREG ;regular stuff

 S APCHSINT="",APCHSCRI=$$SITECRIT^APCHSMU(APCHSITI)

 I 'APCHSCRI D

 .Q:APCHSAGE<21

 .Q:APCHSAGE>64

 .S APCHSINT=(3*365)

 .S APCHMIN=21

 I APCHSCRI S APCHSINT=$$AGESEX^APCHSMU(APCHSITI,APCHSPAT),APCHMIN=$$MINAGE^APCHSMU(APCHSITI,APCHSPAT)

 I APCHSINT="" X APCHSURX Q

 ;check for hysterectomy

 I $$HYSTER(APCHSPAT) S APCHSTEX(1)="Patient has had hysterectomy",APCHSTEX(2)="Pap may be needed based on",APCHSTEX(3)="clinical assessment." D PAPWT Q

 I APCHLAST="" S APCHSTEX(1)=$$DATE^APCHSMU($$DATEAGE^APCHSMU(APCHSPAT,APCHMIN)) D  Q

 .D PAPWT

 I APCHSAGE<30 D  Q

 .S APCHNEXT=$$FMADD^XLFDT(APCHLAST,APCHSINT)

 .I APCHNEXT>DT S APCHSTEX(1)=$$DATE^APCHSMU(APCHNEXT)

 .I APCHNEXT'>DT S APCHSTEX(1)=$$DATE^APCHSMU(APCHNEXT)

 .D PAPWT

 ;30-64

 ;IF HAD PAP IN PAST 3 YRS, DISPLAY NEXT INFO AND DON'T WORRY ABOUT HPV TEST

 I $$FMDIFF^XLFDT(APCHLAST,DT)<(3*365) D  Q

 .S APCHNEXT=$$FMADD^XLFDT(APCHLAST,APCHSINT)

 .S APCHSTEX(1)=$$DATE^APCHSMU(APCHNEXT)

 .S APCHSTEX(2)="PAP every 3 years: Next: "_$$DATE^APCHSMU(APCHNEXT)

 .S APCHSTEX(3)="or PAP and high risk HPV test "

 .S APCHSTEX(4)=" every 5 years:  Next: "_$$DATE^APCHSMU($$FMADD^XLFDT(APCHLAST,(5*365)))

 .D PAPWT

 ;IF HAD PAP AND HPV IN PAST 5 YRS DISPLAY NEXT PAP+5

 S APCHHPV=$P($$LASTHPV(APCHSPAT),U,2)

 I $$FMDIFF^XLFDT(APCHLAST,DT)<(5*365),$$FMDIFF^XLFDT(APCHLAST,DT)<(5*365) D  Q

 .S APCHNEXT=$$FMADD^XLFDT(APCHLAST,(5*365))

 .S APCHSTEX(1)=$$DATE^APCHSMU(APCHNEXT)

 .S APCHSTEX(2)="PAP every 3 years: Next: "_$$DATE^APCHSMU($$FMADD^XLFDT(APCHLAST,(3*365)))

 .S APCHSTEX(3)="or PAP and high risk HPV test "

 .S APCHSTEX(4)=" every 5 years:  Next: "_$$DATE^APCHSMU(APCHNEXT)

 .D PAPWT

 S APCHNEXT=$$FMADD^XLFDT(APCHLAST,APCHSINT)

 S APCHSTEX(1)=$$DATE^APCHSMU(APCHNEXT)

 S APCHSTEX(2)="PAP every 3 years: Next: "_$$DATE^APCHSMU(APCHNEXT)

 S APCHSTEX(3)="PAP and high risk HPV test "

 S APCHSTEX(4)=" every 5 years:  Next: "_$$DATE^APCHSMU($$FMADD^XLFDT(APCHLAST,(5*365)))

 D PAPWT

 Q

HYSTER(P) ;EP has patient had hysterectomy?

 I '$G(P) Q ""

 ;I '$D(^AUPNVPRC("AC",P)) Q ""

 N APCHSVDT

 NEW F,S,C S (F,S)=0 F  S F=$O(^AUPNVPRC("AC",P,F)) Q:F'=+F!(S)  I $D(^AUPNVPRC(F,0)) S APCHSVDT=$P(+^AUPNVSIT($P(^AUPNVPRC(F,0),U,3),0),"."),C=$P($$ICDOP^ICDEX(+^AUPNVPRC(F,0),APCHSVDT,,"I"),U,1) D

 .S:$$ICD^ATXAPI(C,$O(^ATXAX("B","BGP HYSTERECTOMY PROCEDURES",0)),1) S=1

 I S=1 Q 1

 I $P($$LASTDX^APCHSMU2(P,"BGP HYSTERECTOMY DXS"),U) Q 1  ;had this dx

 S T="HYSTERECTOMY",T=$O(^BWPN("B",T,0))

 I T D  I X Q 1

 .S X=$$WH^APCHSMU2(P,$$DOB^AUPNPAT(P),DT,T,1)

 S T=$O(^ATXAX("B","BGP HYSTERECTOMY CPTS",0))

 I T D  I X Q 1

 .S X=$$CPT^APCHSMU2(P,$P(^DPT(P,0),U,3),DT,T,1)

 Q ""

LASTHPV(P) ;EP

 NEW APCHC,APCHLPAP,T,APCHLT,B,D,E,L,X,J,APCH

 S APCHC=""

 S APCHLPAP=""

 S BDATE=$$DOB^AUPNPAT(P)

 S EDATE=DT

 S T=$O(^ATXAX("B","BGP HPV LOINC CODES",0))

 S APCHLT=$O(^ATXLAB("B","BGP HPV TESTS TAX",0))

 S B=9999999-BDATE,E=9999999-EDATE S D=E-1 F  S D=$O(^AUPNVLAB("AE",P,D)) Q:D'=+D!(D>B)!(APCHC]"")  D

 .S L=0 F  S L=$O(^AUPNVLAB("AE",P,D,L)) Q:L'=+L!(APCHC]"")  D

 ..S X=0 F  S X=$O(^AUPNVLAB("AE",P,D,L,X)) Q:X'=+X!(APCHC]"")  D

 ...Q:'$D(^AUPNVLAB(X,0))

 ...S Z=$P(^AUPNVLAB(X,0),U),Z=$P($G(^LAB(60,Z,0)),U) I Z="HPV" S APCHC="1^"_(9999999-D)_"^Lab" Q

 ...I APCHLT,$P(^AUPNVLAB(X,0),U),$D(^ATXLAB(APCHLT,21,"B",$P(^AUPNVLAB(X,0),U))) S APCHC="1^"_(9999999-D)_"^Lab" Q

 ...Q:'T

 ...S J=$P($G(^AUPNVLAB(X,11)),U,13) Q:J=""

 ...Q:'$$LOINC(J,T)

 ...S APCHC="1^"_(9999999-D)_"^Lab-loinc" Q

 ...Q

 S APCHLPAP=APCHC

 K APCH

 S T="BGP HPV DXS"

 S X=$$LASTDXT^APCLAPIU(P,,,"BGP HPV DXS","D") I X,$P(APCHLPAP,U,2)<X S APCHLPAP="1^"_X_"^HPV POV "

 S T=$O(^ATXAX("B","BGP HPV CPTS",0))

 I T D  I X]"",$P(APCHLPAP,U,2)<$P(X,U,1) S APCHLPAP="1^"_$P(X,U)_"^CPT "_$P(X,U,2)

 .S X=$$CPT^APCHSMU2(P,BDATE,EDATE,T,5) I X]"" Q

 Q APCHLPAP

WW ;EP - WiseWoman reminder - Mike Mosley

 N WWSTAT,APCHLAST,APCHNEXT,APCHSTEX

 Q:'$$INAC^APCHSMU(APCHSITI)

 Q:APCHSEX'="F"

 S (APCHLAST,APCHNEXT)="" K APCHSTEX

 S APCHOVR=$$OVR^APCHSMU(APCHSPAT,APCHSITI)

 S WWSTAT=$$GET1^DIQ(9000001,APCHSPAT,1709,"I")

 Q:WWSTAT>1&(WWSTAT<4)

 I $$HASWWP(APCHSPAT) D

 .S APCHLAST=$$WWPDT(APCHSPAT)

 .S APCHNEXT=$$FMADD^XLFDT(APCHLAST,305)

 .I APCHNEXT'>DT S APCHSTEX(1)="MAY BE DUE NOW (WAS DUE "_$$DATE^APCHSMU(APCHNEXT)_")"

 .E  S APCHSTEX(1)=$$DATE^APCHSMU(APCHNEXT)

 E  D

 .S:APCHSAGE>29&(APCHSAGE<65) APCHSTEX(1)="MAY BE DUE NOW"

 D:$D(APCHSTEX) WRITE^APCHSMU

 X APCHSURX

 Q

WWPDT(DFN) ;

 N IEN,PDT,WWP

 S PDT=0

 Q:'$G(DFN) PDT

 S PDT=0,IEN=$C(1) F  S IEN=$O(^BWPCD("C",DFN,IEN),-1) Q:'IEN!PDT  D

 .S WWP=$$GET1^DIQ(9002086.1,IEN,4.01,"I")

 .I WWP=1!(WWP=2) S PDT=$$GET1^DIQ(9002086.1,IEN,4.02,"I")

 Q PDT

 ;

HASWWP(DFN) ;

 N IEN,FLG

 S (FLG,IEN)=0 F  S IEN=$O(^BWPCD("C",DFN,IEN)) Q:'IEN!FLG  D

 .I $$GET1^DIQ(9002086.1,IEN,4.01,"I")=1 S FLG=1

 Q FLG

PAPDAYS(P) ;PEP - called from WH to return # of days

 ;          from last pap until this patient's next pap is due

 ;          0 = clinical discretion (had hysterectomy)

 ;          -1 = patient not eligible for this reminder

 ;          return = # days

 I '$G(P) Q -1

 ;is patient eligible for this reminder per specifications in hmr file?

 NEW APCHSITI,APCHSCRI,G

 S APCHSITI=$O(^APCHSURV("B","PAP SMEAR",0))

 S APCHSCRI=$$SITECRIT^APCHSMU(APCHSITI)

 I $$HYSTER(P) Q 0  ;if hysterectomy then clinical discretion

 I 'APCHSCRI D  Q G

 .S G=-1

 .Q:$$AGE^AUPNPAT(P,DT)<18

 .S G=(3*365)

 S G=$$AGESEX^APCHSMU(APCHSITI,P),G=$P(G,".")

 I 'G Q -1

 Q G

MAMDAYS(P) ;PEP - called from WH to return # of days 

 ;          from last mammogram that the next one is due

 ;          -1 = patient not eligible for this reminder

 ;          return = # days

 I '$G(P) Q -1

 ;is patient eligible for this reminder per specifications in hmr file?

 NEW APCHSITI,APCHSCRI,G

 S APCHSITI=$O(^APCHSURV("B","MAMMOGRAM",0))

 S APCHSCRI=$$SITECRIT^APCHSMU(APCHSITI)

 I 'APCHSCRI D  Q G

 .S G=-1

 .Q:$$AGE^AUPNPAT(P,DT)<50

 .Q:$$AGE^AUPNPAT(P,DT)>69

 .S G=365

 S G=$$AGESEX^APCHSMU(APCHSITI,P),G=$P(G,".")

 I 'G Q -1

 Q G

LOINC(A,B) ;

 NEW %

 S %=$P($G(^LAB(95.3,A,9999999)),U,2)

 I %]"",$D(^ATXAX(B,21,"B",%)) Q 1

 S %=$P($G(^LAB(95.3,A,0)),U)_"-"_$P($G(^LAB(95.3,A,0)),U,15)

 I $D(^ATXAX(B,21,"B",%)) Q 1

 Q ""