APCHPST1 ; IHS/CMI/LAB - Patient Health Summary - Post Visit ;
;;2.0;IHS PCC SUITE;**5,7,11**;MAY 14, 2009;Build 58
;
;
;
EP(APCHSDFN) ;PEP - PASS DFN get back array of patient care summary
;at this point you are stuck with ^TMP("APCHPHS",$J,"PHS"
K ^TMP("APCHPHS",$J,"PHS")
S ^TMP("APCHPHS",$J,"PHS",0)=0
D SETARRAY
Q
SETARRAY ;set up array containing dm care summary
;CHECK TO SEE IF START1^APCLDF EXISTS
S X="APCLDF" X ^%ZOSF("TEST") I '$T Q
S X="PATIENT HEALTH SUMMARY Report Date: "_$$FMTE^XLFDT(DT) D S(X)
S X=$P($P(^DPT(APCHSDFN,0),U),",",2)_" "_$P($P(^DPT(APCHSDFN,0),U),",")_" HRN: "_$$HRN^AUPNPAT(APCHSDFN,DUZ(2)),$E(X,50)=$S($P(^APCCCTRL(DUZ(2),0),U,13)]"":$P(^APCCCTRL(DUZ(2),0),U,13),1:$P(^DIC(4,DUZ(2),0),U)) D S(X,2)
I $G(APCDVSIT)]"",$D(^AUPNVSIT("AC",APCHSDFN,APCDVSIT)) S APCHPROV=$$PRIMPROV^APCLV(APCDVSIT)
S X=$$VAL^XBDIQ1(2,APCHSDFN,.111),$E(X,50)=$S($G(APCHPROV)]"":APCHPROV,1:$$VAL^XBDIQ1(9000001,APCHSDFN,.14)) D S(X) ;GARY - ADD CHECK FOR CURRENT VISIT PROVIDER
S X=$$VAL^XBDIQ1(2,APCHSDFN,.114)_$S($$VAL^XBDIQ1(2,APCHSDFN,.114)]"":", ",1:" ")_$$VAL^XBDIQ1(2,APCHSDFN,.115)_" "_$$VAL^XBDIQ1(2,APCHSDFN,.116),Y=$P(^AUTTLOC(DUZ(2),0),U,11),$E(X,50)=Y D S(X)
S X=$$FMTE^XLFDT(DT) D S(X)
S X="Hello "_$S($$SEX^AUPNPAT(APCHSDFN)="M":"Mr. ",1:"Ms. ")_$E($P($P(^DPT(APCHSDFN,0),U),","))_$$LOW^XLFSTR($E($P($P(^DPT(APCHSDFN,0),U),","),2,99))_"," D S(X,1)
S X="Thank you for visiting with us! Here's some information about your visit." D S(X,1)
S X="When you have any questions, contact your health care provider or write them" D S(X)
S X="down and ask them at your next visit." D S(X)
;
MEDS ;
D EP^APCHPST2 ;meds/ allergies/ measurements
CKDP ;
;does pt have chronic kidney disease?
D CKD
I $G(APCHX("BP"))]"" S APCHHBP=0 D
.I $G(APCHDBP)<80,$G(APCHSBP)<140 Q
.I $G(APCHDBP)>90!($G(APCHSBP)>140) S APCHHBP=1 Q
.I $$DMDX(APCHSDFN)="Yes",$G(APCHDBP)>80!($G(APCHSBP)>130) S APCHHBP=1
.I $G(APCHCKD)=1,$G(APCHDBP)>80!($G(APCHSBP)>130) S APCHHBP=1
I $G(APCHHBP)=0 S X="",$E(X,5)="Your blood pressure is good. That's great news!" D S(X)
I $G(APCHHBP)=1 D
.S X="",$E(X,5)="Your blood pressure is too high. Easy ways to make it better are" D S(X)
.S X="",$E(X,5)="eating healthy foods and walking or getting more physical activity." D S(X)
.S X="",$E(X,5)="If you take medicine to lower your blood pressure, be sure to take" D S(X)
.S X="",$E(X,5)="it every day." D S(X)
;
LABTESTS ;
;S X="Lab tests can help measure health and some check to make sure that your" D S(X,1)
;S X="medicines are working right." D S(X)
;diabetes
S APCHLHD=""
I $$DMDX(APCHSDFN)="Yes" S T=$O(^ATXLAB("B","DM AUDIT HGB A1C TAX",0)) I $G(T)]"" S APCHLA1V=$$LAB(APCHSDFN,T),APCHLA1D=$P($G(APCHLA1V),"|||",2),APCHLA1V=$P($G(APCHLA1V),"|||") D
.I APCHLA1D="",APCHLHD="" D APCHLHD S APCHLHD=1 S X="",$E(X,5)="You need to have your A1C checked to see if your diabetes is under control." D S(X)
.I APCHLA1D]"" S X=APCHLA1D D ^%DT S APCHLA1D=Y S X1=DT,X2=APCHLA1D I $$FMDIFF^XLFDT(X1,X2)>180 D
..I APCHLHD=1 S X="",$E(X,5)="You need to have your A1C checked to see if your diabetes is under control." D S(X)
..I APCHLHD="" D APCHLHD S APCHLHD=1 S X="",$E(X,5)="You need to have your A1C checked to see if your diabetes is under control." D S(X)
..S T=$O(^ATXLAB("B","DM AUDIT CHOLESTEROL TAX",0)) I $G(T)]"" D
...S APCHLCHV=$$LAB(APCHSDFN,T),APCHLCHD=$P($G(APCHLCHV),"|||",2),APCHLCHV=$P($G(APCHLCHV),"|||") I APCHLCHD]"" S X=APCHLCHD D ^%DT S APCHLCHD=Y S X1=DT,X2=APCHLCHD I $$FMDIFF^XLFDT(X1,X2)>180 D
....I APCHLHD=1 S APCHCKCH=1 S X="",$E(X,5)="You need to have your cholesterol checked to prevent heart disease." D S(X)
....I APCHLHD="" D APCHLHD S APCHLHD=1 S X="",$E(X,5)="You need to have your cholesterol checked to prevent heart disease." D S(X)
.Q
;cholesterol
I $G(APCHCKCH)']"",$$AGE^AUPNPAT(APCHSDFN)>18,$$DMDX(APCHSDFN)="No" S T=$O(^ATXLAB("B","DM AUDIT CHOLESTEROL TAX",0)) I $G(T)]"" S APCHLCHV=$$LAB(APCHSDFN,T),APCHLCHD=$P($G(APCHLCHV),"|||",2),APCHLCHV=$P($G(APCHLCHV),"|||") D
.I APCHLCHD="" D APCHLHD S APCHLHD=1 S X="",$E(X,5)="You need to have your cholesterol checked to prevent heart disease." D S(X)
.I APCHLCHD]"" S X=APCHLCHD D ^%DT S APCHLCHD=Y S X1=DT,X2=APCHLCHD I $$FMDIFF^XLFDT(X1,X2)>1825 D APCHLHD S APCHLHD=1 S X="",$E(X,5)="You need to have your cholesterol checked to prevent heart disease." D S(X)
;
D GETLABS
I $D(APCHTST),$G(APCHLHD)="" D APCHLHD S APCHLHD=1
I $D(APCHTST) S X="",$E(X,5)="Lab tests ordered today:" D S(X)
S APCHSLAB=""
F S APCHSLAB=$O(APCHTST(APCHSLAB)) Q:$G(APCHSLAB)']"" D
.S X="",$E(X,10)=APCHSLAB D S(X)
.I $O(APCHTST(APCHSLAB,0)) S APCHCTR=0 F S APCHCTR=$O(APCHTST(APCHSLAB,APCHCTR)) Q:'APCHCTR D
..S X="",$E(X,12)=$P(APCHTST(APCHSLAB,APCHCTR),U) D S(X)
.Q
;
IMMUN ;
S X="Immunizations make your body stronger to fight infections." D S(X,1)
;
D IMMFORC^BIRPC(.APCHIMM,APCHSDFN)
I $E($G(APCHIMM),1,2)="No" S X="",$E(X,5)="You have all your immunizations. That's Great!" D S(X)
I $E($G(APCHIMM),1,2)=" " F APCHIMMN=1:1 S APCHIMMT=$P($P(APCHIMM,U,APCHIMMN),"|") Q:$G(APCHIMMT)']"" D
.I $E(APCHIMMT,1,2)=" " S APCHIMMT=$E(APCHIMMT,3,99)
.I $G(APCHIMMT)]"" S APCHI(APCHIMMN)=APCHIMMT
.Q
I $G(APCHIMM)]"",+APCHIMM S X="",$E(X,5)="Immunizations are due." D S(X)
I $D(APCHI) S APCHICTR=0 D
.S X="",$E(X,5)="You can get these immunizations today:" D S(X)
.F S APCHICTR=$O(APCHI(APCHICTR)) Q:APCHICTR'=+APCHICTR D
..S APCHIMDU=$P(APCHI(APCHICTR),U),X="",$E(X,5)=APCHIMDU D S(X)
..Q
;
MISC ;
S X="Good health starts with you. Some basic rules can keep you safe." D S(X,1)
S X="Here are two checklists to help you and your family safe." D S(X)
S X="",$E(X,5)="To help protect yourself at home:" D S(X)
S X="",$E(X,10)="Use smoke detectors. Remember to check the batteries every month." D S(X)
S X="",$E(X,10)="Change the batteries every year. You may want to use a reminder." D S(X)
S X="",$E(X,10)="For example, change the batteries around your birthday, some holiday" D S(X)
S X="",$E(X,10)="or at daylight savings time." D S(X)
S X="",$E(X,10)="Lock up guns and ammunition, and store them separately." D S(X)
S X="",$E(X,10)="Keep good lights on in hallways, stairways and porches." D S(X)
S X="",$E(X,10)="Fix, or get rid of, things you can trip on such as loose rugs," D S(X)
S X="",$E(X,10)="electrical cords and toys." D S(X)
S X="",$E(X,5)="To help protect you away from home:" D S(X,1)
S X="",$E(X,10)="Wear seat belts - ALWAYS!" D S(X)
S X="",$E(X,10)="Never drive after drinking alcohol-or get in a car with a driver" D S(X)
S X="",$E(X,10)="who was drinking." D S(X)
S X="",$E(X,10)="Always wear a safety helmet while riding a motorcycle or bicycle." D S(X)
S X="",$E(X,10)="Look out for hazards where you work. Follow workplace safety rules." D S(X)
Q
CKD ;Does patient have chronic kidney disease (CKD)?
S APCHCKD=0
;get last serum creatinine value
S T=$O(^ATXLAB("B","DM AUDIT CREATININE TAX",0)) I $G(T)]"" S APCHLCRV=$$LAB(APCHSDFN,T),APCHLCRD=$P($G(APCHLCRV),"|||",2),APCHLCRV=$P($G(APCHLCRV),"|||") I $G(APCHLCRV)]"" D
.I $$SEX^AUPNPAT(APCHSDFN)="F",APCHLCRV>1.3 S APCHCKD=1
.I $$SEX^AUPNPAT(APCHSDFN)="M",APCHLCRV>1.5 S APCHCKD=1
;get last urine protein value
Q:APCHCKD=1 S T=$O(^ATXLAB("B","DM AUDIT URINE PROTEIN TAX",0)) I $G(T)]"" S APCHLUPV=$$LAB(APCHSDFN,T),APCHLUPD=$P($G(APCHLUPV),"|||",2),APCHLUPV=$P($G(APCHLUPV),"|||") I $G(APCHLUPV)]"" D
.I +APCHLUPV>200 S APCHCKD=1
;get last A/C ratio value
Q:APCHCKD=1 S T=$O(^ATXLAB("B","DM AUDIT A/C RATIO TAX",0)) I $G(T)]"" S APCHLACV=$$LAB(APCHSDFN,T),APCHLACD=$P($G(APCHLACV),"|||",2),APCHLACV=$P($G(APCHLACV),"|||") I $G(APCHLACV)]"" D
.I +APCHLACV>200 S APCHCKD=1
;get estimated GFR
Q:APCHCKD=1 S T=$O(^ATXLAB("B","BGP GPRA ESTIMATED GFR TAX",0)) I $G(T)]"" S APCHLEGV=$$LAB(APCHSDFN,T),APCHLEGD=$P($G(APCHLEGV),"|||",2),APCHLEGV=$P($G(APCHLEGV),"|||") I $G(APCHLEGV)]"" D
.I APCHLEGV<60 S APCHCKD=1
Q
;
;
S(Y,F,C,T) ;set up array
I '$G(F) S F=0
I '$G(T) S T=0
NEW %,X
;blank lines
F F=1:1:F S X="" D S1
S X=Y
I $G(C) S L=$L(Y),T=(80-L)/2 D D S1 Q
.F %=1:1:(T-1) S X=" "_X
F %=1:1:T S X=" "_Y
D S1
Q
S1 ;
S %=$P(^TMP("APCHPHS",$J,"PHS",0),U)+1,$P(^TMP("APCHPHS",$J,"PHS",0),U)=%
S ^TMP("APCHPHS",$J,"PHS",%)=X
Q
DMDX(P) ;
;check problem list OR must have 3 diagnoses
N T S T=$O(^ATXAX("B","SURVEILLANCE DIABETES",0))
I 'T Q ""
N X,Y,I S (X,Y,I)=0 F S X=$O(^AUPNPROB("AC",P,X)) Q:X'=+X!(I) I $D(^AUPNPROB(X,0)),$P(^AUPNPROB(X,0),U,12)'="D" S Y=$P(^AUPNPROB(X,0),U) I $$ICD^ATXAPI(Y,T,9) S I=1
I I Q "Yes"
NEW APCHX
S APCHX=""
S X=P_"^LAST 3 DX [SURVEILLANCE DIABETES" S E=$$START1^APCLDF(X,"APCHX(") G:E DMX I $D(APCHX(3)) S APCHX="Yes"
I $G(APCHX)="" S APCHX="No"
DMX ;
Q APCHX
;
LAB(P,T,LT) ;EP
I '$G(LT) S LT=""
NEW D,V,G,X,J S (D,G)=0 F S D=$O(^AUPNVLAB("AE",P,D)) Q:D'=+D!(G) D
.S X=0 F S X=$O(^AUPNVLAB("AE",P,D,X)) Q:X'=+X!(G) D
..S Y=0 F S Y=$O(^AUPNVLAB("AE",P,D,X,Y)) Q:Y'=+Y!(G) D
...I $D(^ATXLAB(T,21,"B",X)),$P(^AUPNVLAB(Y,0),U,4)]"" S G=Y Q
...Q:'LT
...S J=$P($G(^AUPNVLAB(Y,11)),U,13) Q:J=""
...Q:'$$LOINC(J,LT)
...S G=Y
...Q
..Q
.Q
I 'G S R=$$REF(P,T) Q "||||||"_R
Q $P(^AUPNVLAB(G,0),U,4)_"|||"_$$FMTE^XLFDT($P($P(^AUPNVSIT($P(^AUPNVLAB(G,0),U,3),0),U),"."))_"|||"_$$REF(P,T,$P($P(^AUPNVSIT($P(^AUPNVLAB(G,0),U,3),0),U),"."))_"|||"_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 ""
;
DATE(D) ;EP - convert to slashed date
I $G(D)="" Q ""
Q $E(D,4,5)_"/"_$E(D,6,7)_"/"_$E(D,2,3)
REF(P,T,D) ;return refusal string after date D for test is tax T
I '$G(P) Q ""
I '$G(T) Q ""
I '$G(D) S D=""
N APCHREF,APCHT,V S APCHT=0 F S APCHT=$O(^ATXLAB(T,21,"B",APCHT)) Q:APCHT'=+APCHT D
.S V=$$REF1(P,60,APCHT,D) I V]"" S APCHREF(9999999-$P(V,U,3))=V
I $D(APCHREF) S %=0,%=$O(APCHREF(%)) I % S V=APCHREF(%) Q V
Q ""
REF1(P,F,I,D,T) ; ;
I '$G(P) Q ""
I '$G(F) Q ""
I '$G(I) Q ""
I $G(D)="" S D=""
I $G(T)="" S T="E"
NEW X,N S X=$O(^AUPNPREF("AA",P,F,I,0))
I 'X Q "" ;none of this item was refused
S N=$O(^AUPNPREF("AA",P,F,I,X,0))
NEW Y S Y=9999999-X
I D]"",Y>D Q $S(T="I":Y,1:$$TYPEREF(N)_"-"_$$DATE(Y))
I T="I" Q Y ;quit on internal form of date
Q $$TYPEREF(N)_"-"_$$DATE(Y)
;
TYPEREF(N) ;
NEW % S %=$P(^AUPNPREF(N,0),U,7)
I %="R"!(%="") Q "Declined"
I %="N" Q "Not Med Ind"
I %="F" Q "No Resp to F/U"
Q ""
;
;
GETLABSX ;get lab tests ordered today
;
S APCHLR=$G(^DPT(APCHSDFN,"LR"))
I $G(APCHLR)]"" S APCHLRO=0,APCHTSTP=0 D
.F S APCHLRO=$O(^LRO(69,DT,1,"AA",APCHLR,APCHLRO)) Q:APCHLRO="" Q:APCHLRO'=+APCHLRO D
..F S APCHTSTP=$O(^LRO(69,DT,1,APCHLRO,2,"B",APCHTSTP)) Q:APCHTSTP'=+APCHTSTP D
...S APCHTCTR=$O(^LRO(69,DT,1,APCHLRO,2,"B",APCHTSTP,0))
...S APCHTEST=$P(^LAB(60,APCHTSTP,0),U)
...S APCHTST(APCHTEST)=""
...Q
;
;
GETLABS ;get todays labs from V Lab File
S APCHSIVD=9999999-DT
I $D(^AUPNVLAB("AE",APCHSDFN,APCHSIVD)) S APCHTSTP=0,APCHVLAB=0 D
.F S APCHTSTP=$O(^AUPNVLAB("AE",APCHSDFN,APCHSIVD,APCHTSTP)) Q:APCHTSTP="" Q:APCHTSTP'=+APCHTSTP D
..S APCHTEST=$P(^LAB(60,APCHTSTP,0),U),APCHTST(APCHTEST)=""
..S APCHVLAB=$O(^AUPNVLAB("AE",APCHSDFN,APCHSIVD,APCHTSTP,APCHVLAB)) Q:APCHVLAB'=+APCHVLAB
..I $D(^AUPNVLAB(APCHVLAB,21)) S APCHCTR=0 F S APCHCTR=$O(^AUPNVLAB(APCHVLAB,21,APCHCTR)) Q:'APCHCTR D
...Q:APCHCTR'=+APCHCTR
...S APCHTST(APCHTEST,APCHCTR)=$P(^AUPNVLAB(APCHVLAB,21,APCHCTR,0),U)
..Q
Q
;
APCHLHD ;
S X="Lab tests can help measure health and some check to make sure that your" D S(X,1)
S X="medicines are working right." D S(X)
;
APCHPST1 ; IHS/CMI/LAB - Patient Health Summary - Post Visit ;
+1 ;;2.0;IHS PCC SUITE;**5,7,11**;MAY 14, 2009;Build 58
+2 ;
+3 ;
+4 ;
EP(APCHSDFN) ;PEP - PASS DFN get back array of patient care summary
+1 ;at this point you are stuck with ^TMP("APCHPHS",$J,"PHS"
+2 KILL ^TMP("APCHPHS",$JOB,"PHS")
+3 SET ^TMP("APCHPHS",$JOB,"PHS",0)=0
+4 DO SETARRAY
+5 QUIT
SETARRAY ;set up array containing dm care summary
+1 ;CHECK TO SEE IF START1^APCLDF EXISTS
+2 SET X="APCLDF"
XECUTE ^%ZOSF("TEST")
IF '$TEST
QUIT
+3 SET X="PATIENT HEALTH SUMMARY Report Date: "_$$FMTE^XLFDT(DT)
DO S(X)
+4 SET X=$PIECE($PIECE(^DPT(APCHSDFN,0),U),",",2)_" "_$PIECE($PIECE(^DPT(APCHSDFN,0),U),",")_" HRN: "_$$HRN^AUPNPAT(APCHSDFN,DUZ(2))
SET $EXTRACT(X,50)=$SELECT($PIECE(^APCCCTRL(DUZ(2),0),U,13)]"":$PIECE(^APCCCTRL(DUZ(2),0),U,13),1:$PIECE(^DIC(4,DUZ(2),0),U))
DO S(X,2)
+5 IF $GET(APCDVSIT)]""
IF $DATA(^AUPNVSIT("AC",APCHSDFN,APCDVSIT))
SET APCHPROV=$$PRIMPROV^APCLV(APCDVSIT)
+6 ;GARY - ADD CHECK FOR CURRENT VISIT PROVIDER
SET X=$$VAL^XBDIQ1(2,APCHSDFN,.111)
SET $EXTRACT(X,50)=$SELECT($GET(APCHPROV)]"":APCHPROV,1:$$VAL^XBDIQ1(9000001,APCHSDFN,.14))
DO S(X)
+7 SET X=$$VAL^XBDIQ1(2,APCHSDFN,.114)_$SELECT($$VAL^XBDIQ1(2,APCHSDFN,.114)]"":", ",1:" ")_$$VAL^XBDIQ1(2,APCHSDFN,.115)_" "_$$VAL^XBDIQ1(2,APCHSDFN,.116)
SET Y=$PIECE(^AUTTLOC(DUZ(2),0),U,11)
SET $EXTRACT(X,50)=Y
DO S(X)
+8 SET X=$$FMTE^XLFDT(DT)
DO S(X)
+9 SET X="Hello "_$SELECT($$SEX^AUPNPAT(APCHSDFN)="M":"Mr. ",1:"Ms. ")_$EXTRACT($PIECE($PIECE(^DPT(APCHSDFN,0),U),","))_$$LOW^XLFSTR($EXTRACT($PIECE($PIECE(^DPT(APCHSDFN,0),U),","),2,99))_","
DO S(X,1)
+10 SET X="Thank you for visiting with us! Here's some information about your visit."
DO S(X,1)
+11 SET X="When you have any questions, contact your health care provider or write them"
DO S(X)
+12 SET X="down and ask them at your next visit."
DO S(X)
+13 ;
MEDS ;
+1 ;meds/ allergies/ measurements
DO EP^APCHPST2
CKDP ;
+1 ;does pt have chronic kidney disease?
+2 DO CKD
+3 IF $GET(APCHX("BP"))]""
SET APCHHBP=0
Begin DoDot:1
+4 IF $GET(APCHDBP)<80
IF $GET(APCHSBP)<140
QUIT
+5 IF $GET(APCHDBP)>90!($GET(APCHSBP)>140)
SET APCHHBP=1
QUIT
+6 IF $$DMDX(APCHSDFN)="Yes"
IF $GET(APCHDBP)>80!($GET(APCHSBP)>130)
SET APCHHBP=1
+7 IF $GET(APCHCKD)=1
IF $GET(APCHDBP)>80!($GET(APCHSBP)>130)
SET APCHHBP=1
End DoDot:1
+8 IF $GET(APCHHBP)=0
SET X=""
SET $EXTRACT(X,5)="Your blood pressure is good. That's great news!"
DO S(X)
+9 IF $GET(APCHHBP)=1
Begin DoDot:1
+10 SET X=""
SET $EXTRACT(X,5)="Your blood pressure is too high. Easy ways to make it better are"
DO S(X)
+11 SET X=""
SET $EXTRACT(X,5)="eating healthy foods and walking or getting more physical activity."
DO S(X)
+12 SET X=""
SET $EXTRACT(X,5)="If you take medicine to lower your blood pressure, be sure to take"
DO S(X)
+13 SET X=""
SET $EXTRACT(X,5)="it every day."
DO S(X)
End DoDot:1
+14 ;
LABTESTS ;
+1 ;S X="Lab tests can help measure health and some check to make sure that your" D S(X,1)
+2 ;S X="medicines are working right." D S(X)
+3 ;diabetes
+4 SET APCHLHD=""
+5 IF $$DMDX(APCHSDFN)="Yes"
SET T=$ORDER(^ATXLAB("B","DM AUDIT HGB A1C TAX",0))
IF $GET(T)]""
SET APCHLA1V=$$LAB(APCHSDFN,T)
SET APCHLA1D=$PIECE($GET(APCHLA1V),"|||",2)
SET APCHLA1V=$PIECE($GET(APCHLA1V),"|||")
Begin DoDot:1
+6 IF APCHLA1D=""
IF APCHLHD=""
DO APCHLHD
SET APCHLHD=1
SET X=""
SET $EXTRACT(X,5)="You need to have your A1C checked to see if your diabetes is under control."
DO S(X)
+7 IF APCHLA1D]""
SET X=APCHLA1D
DO ^%DT
SET APCHLA1D=Y
SET X1=DT
SET X2=APCHLA1D
IF $$FMDIFF^XLFDT(X1,X2)>180
Begin DoDot:2
+8 IF APCHLHD=1
SET X=""
SET $EXTRACT(X,5)="You need to have your A1C checked to see if your diabetes is under control."
DO S(X)
+9 IF APCHLHD=""
DO APCHLHD
SET APCHLHD=1
SET X=""
SET $EXTRACT(X,5)="You need to have your A1C checked to see if your diabetes is under control."
DO S(X)
+10 SET T=$ORDER(^ATXLAB("B","DM AUDIT CHOLESTEROL TAX",0))
IF $GET(T)]""
Begin DoDot:3
+11 SET APCHLCHV=$$LAB(APCHSDFN,T)
SET APCHLCHD=$PIECE($GET(APCHLCHV),"|||",2)
SET APCHLCHV=$PIECE($GET(APCHLCHV),"|||")
IF APCHLCHD]""
SET X=APCHLCHD
DO ^%DT
SET APCHLCHD=Y
SET X1=DT
SET X2=APCHLCHD
IF $$FMDIFF^XLFDT(X1,X2)>180
Begin DoDot:4
+12 IF APCHLHD=1
SET APCHCKCH=1
SET X=""
SET $EXTRACT(X,5)="You need to have your cholesterol checked to prevent heart disease."
DO S(X)
+13 IF APCHLHD=""
DO APCHLHD
SET APCHLHD=1
SET X=""
SET $EXTRACT(X,5)="You need to have your cholesterol checked to prevent heart disease."
DO S(X)
End DoDot:4
End DoDot:3
End DoDot:2
+14 QUIT
End DoDot:1
+15 ;cholesterol
+16 IF $GET(APCHCKCH)']""
IF $$AGE^AUPNPAT(APCHSDFN)>18
IF $$DMDX(APCHSDFN)="No"
SET T=$ORDER(^ATXLAB("B","DM AUDIT CHOLESTEROL TAX",0))
IF $GET(T)]""
SET APCHLCHV=$$LAB(APCHSDFN,T)
SET APCHLCHD=$PIECE($GET(APCHLCHV),"|||",2)
SET APCHLCHV=$PIECE($GET(APCHLCHV),"|||")
Begin DoDot:1
+17 IF APCHLCHD=""
DO APCHLHD
SET APCHLHD=1
SET X=""
SET $EXTRACT(X,5)="You need to have your cholesterol checked to prevent heart disease."
DO S(X)
+18 IF APCHLCHD]""
SET X=APCHLCHD
DO ^%DT
SET APCHLCHD=Y
SET X1=DT
SET X2=APCHLCHD
IF $$FMDIFF^XLFDT(X1,X2)>1825
DO APCHLHD
SET APCHLHD=1
SET X=""
SET $EXTRACT(X,5)="You need to have your cholesterol checked to prevent heart disease."
DO S(X)
End DoDot:1
+19 ;
+20 DO GETLABS
+21 IF $DATA(APCHTST)
IF $GET(APCHLHD)=""
DO APCHLHD
SET APCHLHD=1
+22 IF $DATA(APCHTST)
SET X=""
SET $EXTRACT(X,5)="Lab tests ordered today:"
DO S(X)
+23 SET APCHSLAB=""
+24 FOR
SET APCHSLAB=$ORDER(APCHTST(APCHSLAB))
IF $GET(APCHSLAB)']""
QUIT
Begin DoDot:1
+25 SET X=""
SET $EXTRACT(X,10)=APCHSLAB
DO S(X)
+26 IF $ORDER(APCHTST(APCHSLAB,0))
SET APCHCTR=0
FOR
SET APCHCTR=$ORDER(APCHTST(APCHSLAB,APCHCTR))
IF 'APCHCTR
QUIT
Begin DoDot:2
+27 SET X=""
SET $EXTRACT(X,12)=$PIECE(APCHTST(APCHSLAB,APCHCTR),U)
DO S(X)
End DoDot:2
+28 QUIT
End DoDot:1
+29 ;
IMMUN ;
+1 SET X="Immunizations make your body stronger to fight infections."
DO S(X,1)
+2 ;
+3 DO IMMFORC^BIRPC(.APCHIMM,APCHSDFN)
+4 IF $EXTRACT($GET(APCHIMM),1,2)="No"
SET X=""
SET $EXTRACT(X,5)="You have all your immunizations. That's Great!"
DO S(X)
+5 IF $EXTRACT($GET(APCHIMM),1,2)=" "
FOR APCHIMMN=1:1
SET APCHIMMT=$PIECE($PIECE(APCHIMM,U,APCHIMMN),"|")
IF $GET(APCHIMMT)']""
QUIT
Begin DoDot:1
+6 IF $EXTRACT(APCHIMMT,1,2)=" "
SET APCHIMMT=$EXTRACT(APCHIMMT,3,99)
+7 IF $GET(APCHIMMT)]""
SET APCHI(APCHIMMN)=APCHIMMT
+8 QUIT
End DoDot:1
+9 IF $GET(APCHIMM)]""
IF +APCHIMM
SET X=""
SET $EXTRACT(X,5)="Immunizations are due."
DO S(X)
+10 IF $DATA(APCHI)
SET APCHICTR=0
Begin DoDot:1
+11 SET X=""
SET $EXTRACT(X,5)="You can get these immunizations today:"
DO S(X)
+12 FOR
SET APCHICTR=$ORDER(APCHI(APCHICTR))
IF APCHICTR'=+APCHICTR
QUIT
Begin DoDot:2
+13 SET APCHIMDU=$PIECE(APCHI(APCHICTR),U)
SET X=""
SET $EXTRACT(X,5)=APCHIMDU
DO S(X)
+14 QUIT
End DoDot:2
End DoDot:1
+15 ;
MISC ;
+1 SET X="Good health starts with you. Some basic rules can keep you safe."
DO S(X,1)
+2 SET X="Here are two checklists to help you and your family safe."
DO S(X)
+3 SET X=""
SET $EXTRACT(X,5)="To help protect yourself at home:"
DO S(X)
+4 SET X=""
SET $EXTRACT(X,10)="Use smoke detectors. Remember to check the batteries every month."
DO S(X)
+5 SET X=""
SET $EXTRACT(X,10)="Change the batteries every year. You may want to use a reminder."
DO S(X)
+6 SET X=""
SET $EXTRACT(X,10)="For example, change the batteries around your birthday, some holiday"
DO S(X)
+7 SET X=""
SET $EXTRACT(X,10)="or at daylight savings time."
DO S(X)
+8 SET X=""
SET $EXTRACT(X,10)="Lock up guns and ammunition, and store them separately."
DO S(X)
+9 SET X=""
SET $EXTRACT(X,10)="Keep good lights on in hallways, stairways and porches."
DO S(X)
+10 SET X=""
SET $EXTRACT(X,10)="Fix, or get rid of, things you can trip on such as loose rugs,"
DO S(X)
+11 SET X=""
SET $EXTRACT(X,10)="electrical cords and toys."
DO S(X)
+12 SET X=""
SET $EXTRACT(X,5)="To help protect you away from home:"
DO S(X,1)
+13 SET X=""
SET $EXTRACT(X,10)="Wear seat belts - ALWAYS!"
DO S(X)
+14 SET X=""
SET $EXTRACT(X,10)="Never drive after drinking alcohol-or get in a car with a driver"
DO S(X)
+15 SET X=""
SET $EXTRACT(X,10)="who was drinking."
DO S(X)
+16 SET X=""
SET $EXTRACT(X,10)="Always wear a safety helmet while riding a motorcycle or bicycle."
DO S(X)
+17 SET X=""
SET $EXTRACT(X,10)="Look out for hazards where you work. Follow workplace safety rules."
DO S(X)
+18 QUIT
CKD ;Does patient have chronic kidney disease (CKD)?
+1 SET APCHCKD=0
+2 ;get last serum creatinine value
+3 SET T=$ORDER(^ATXLAB("B","DM AUDIT CREATININE TAX",0))
IF $GET(T)]""
SET APCHLCRV=$$LAB(APCHSDFN,T)
SET APCHLCRD=$PIECE($GET(APCHLCRV),"|||",2)
SET APCHLCRV=$PIECE($GET(APCHLCRV),"|||")
IF $GET(APCHLCRV)]""
Begin DoDot:1
+4 IF $$SEX^AUPNPAT(APCHSDFN)="F"
IF APCHLCRV>1.3
SET APCHCKD=1
+5 IF $$SEX^AUPNPAT(APCHSDFN)="M"
IF APCHLCRV>1.5
SET APCHCKD=1
End DoDot:1
+6 ;get last urine protein value
+7 IF APCHCKD=1
QUIT
SET T=$ORDER(^ATXLAB("B","DM AUDIT URINE PROTEIN TAX",0))
IF $GET(T)]""
SET APCHLUPV=$$LAB(APCHSDFN,T)
SET APCHLUPD=$PIECE($GET(APCHLUPV),"|||",2)
SET APCHLUPV=$PIECE($GET(APCHLUPV),"|||")
IF $GET(APCHLUPV)]""
Begin DoDot:1
+8 IF +APCHLUPV>200
SET APCHCKD=1
End DoDot:1
+9 ;get last A/C ratio value
+10 IF APCHCKD=1
QUIT
SET T=$ORDER(^ATXLAB("B","DM AUDIT A/C RATIO TAX",0))
IF $GET(T)]""
SET APCHLACV=$$LAB(APCHSDFN,T)
SET APCHLACD=$PIECE($GET(APCHLACV),"|||",2)
SET APCHLACV=$PIECE($GET(APCHLACV),"|||")
IF $GET(APCHLACV)]""
Begin DoDot:1
+11 IF +APCHLACV>200
SET APCHCKD=1
End DoDot:1
+12 ;get estimated GFR
+13 IF APCHCKD=1
QUIT
SET T=$ORDER(^ATXLAB("B","BGP GPRA ESTIMATED GFR TAX",0))
IF $GET(T)]""
SET APCHLEGV=$$LAB(APCHSDFN,T)
SET APCHLEGD=$PIECE($GET(APCHLEGV),"|||",2)
SET APCHLEGV=$PIECE($GET(APCHLEGV),"|||")
IF $GET(APCHLEGV)]""
Begin DoDot:1
+14 IF APCHLEGV<60
SET APCHCKD=1
End DoDot:1
+15 QUIT
+16 ;
+17 ;
S(Y,F,C,T) ;set up array
+1 IF '$GET(F)
SET F=0
+2 IF '$GET(T)
SET T=0
+3 NEW %,X
+4 ;blank lines
+5 FOR F=1:1:F
SET X=""
DO S1
+6 SET X=Y
+7 IF $GET(C)
SET L=$LENGTH(Y)
SET T=(80-L)/2
Begin DoDot:1
+8 FOR %=1:1:(T-1)
SET X=" "_X
End DoDot:1
DO S1
QUIT
+9 FOR %=1:1:T
SET X=" "_Y
+10 DO S1
+11 QUIT
S1 ;
+1 SET %=$PIECE(^TMP("APCHPHS",$JOB,"PHS",0),U)+1
SET $PIECE(^TMP("APCHPHS",$JOB,"PHS",0),U)=%
+2 SET ^TMP("APCHPHS",$JOB,"PHS",%)=X
+3 QUIT
DMDX(P) ;
+1 ;check problem list OR must have 3 diagnoses
+2 NEW T
SET T=$ORDER(^ATXAX("B","SURVEILLANCE DIABETES",0))
+3 IF 'T
QUIT ""
+4 NEW X,Y,I
SET (X,Y,I)=0
FOR
SET X=$ORDER(^AUPNPROB("AC",P,X))
IF X'=+X!(I)
QUIT
IF $DATA(^AUPNPROB(X,0))
IF $PIECE(^AUPNPROB(X,0),U,12)'="D"
SET Y=$PIECE(^AUPNPROB(X,0),U)
IF $$ICD^ATXAPI(Y,T,9)
SET I=1
+5 IF I
QUIT "Yes"
+6 NEW APCHX
+7 SET APCHX=""
+8 SET X=P_"^LAST 3 DX [SURVEILLANCE DIABETES"
SET E=$$START1^APCLDF(X,"APCHX(")
IF E
GOTO DMX
IF $DATA(APCHX(3))
SET APCHX="Yes"
+9 IF $GET(APCHX)=""
SET APCHX="No"
DMX ;
+1 QUIT APCHX
+2 ;
LAB(P,T,LT) ;EP
+1 IF '$GET(LT)
SET LT=""
+2 NEW D,V,G,X,J
SET (D,G)=0
FOR
SET D=$ORDER(^AUPNVLAB("AE",P,D))
IF D'=+D!(G)
QUIT
Begin DoDot:1
+3 SET X=0
FOR
SET X=$ORDER(^AUPNVLAB("AE",P,D,X))
IF X'=+X!(G)
QUIT
Begin DoDot:2
+4 SET Y=0
FOR
SET Y=$ORDER(^AUPNVLAB("AE",P,D,X,Y))
IF Y'=+Y!(G)
QUIT
Begin DoDot:3
+5 IF $DATA(^ATXLAB(T,21,"B",X))
IF $PIECE(^AUPNVLAB(Y,0),U,4)]""
SET G=Y
QUIT
+6 IF 'LT
QUIT
+7 SET J=$PIECE($GET(^AUPNVLAB(Y,11)),U,13)
IF J=""
QUIT
+8 IF '$$LOINC(J,LT)
QUIT
+9 SET G=Y
+10 QUIT
End DoDot:3
+11 QUIT
End DoDot:2
+12 QUIT
End DoDot:1
+13 IF 'G
SET R=$$REF(P,T)
QUIT "||||||"_R
+14 QUIT $PIECE(^AUPNVLAB(G,0),U,4)_"|||"_$$FMTE^XLFDT($PIECE($PIECE(^AUPNVSIT($PIECE(^AUPNVLAB(G,0),U,3),0),U),"."))_"|||"_$$REF(P,T,$PIECE($PIECE(^AUPNVSIT($PIECE(^AUPNVLAB(G,0),U,3),0),U),"."))_"|||"_G
LOINC(A,B) ;
+1 NEW %
+2 SET %=$PIECE($GET(^LAB(95.3,A,9999999)),U,2)
+3 IF %]""
IF $DATA(^ATXAX(B,21,"B",%))
QUIT 1
+4 SET %=$PIECE($GET(^LAB(95.3,A,0)),U)_"-"_$PIECE($GET(^LAB(95.3,A,0)),U,15)
+5 IF $DATA(^ATXAX(B,21,"B",%))
QUIT 1
+6 QUIT ""
+7 ;
DATE(D) ;EP - convert to slashed date
+1 IF $GET(D)=""
QUIT ""
+2 QUIT $EXTRACT(D,4,5)_"/"_$EXTRACT(D,6,7)_"/"_$EXTRACT(D,2,3)
REF(P,T,D) ;return refusal string after date D for test is tax T
+1 IF '$GET(P)
QUIT ""
+2 IF '$GET(T)
QUIT ""
+3 IF '$GET(D)
SET D=""
+4 NEW APCHREF,APCHT,V
SET APCHT=0
FOR
SET APCHT=$ORDER(^ATXLAB(T,21,"B",APCHT))
IF APCHT'=+APCHT
QUIT
Begin DoDot:1
+5 SET V=$$REF1(P,60,APCHT,D)
IF V]""
SET APCHREF(9999999-$PIECE(V,U,3))=V
End DoDot:1
+6 IF $DATA(APCHREF)
SET %=0
SET %=$ORDER(APCHREF(%))
IF %
SET V=APCHREF(%)
QUIT V
+7 QUIT ""
REF1(P,F,I,D,T) ; ;
+1 IF '$GET(P)
QUIT ""
+2 IF '$GET(F)
QUIT ""
+3 IF '$GET(I)
QUIT ""
+4 IF $GET(D)=""
SET D=""
+5 IF $GET(T)=""
SET T="E"
+6 NEW X,N
SET X=$ORDER(^AUPNPREF("AA",P,F,I,0))
+7 ;none of this item was refused
IF 'X
QUIT ""
+8 SET N=$ORDER(^AUPNPREF("AA",P,F,I,X,0))
+9 NEW Y
SET Y=9999999-X
+10 IF D]""
IF Y>D
QUIT $SELECT(T="I":Y,1:$$TYPEREF(N)_"-"_$$DATE(Y))
+11 ;quit on internal form of date
IF T="I"
QUIT Y
+12 QUIT $$TYPEREF(N)_"-"_$$DATE(Y)
+13 ;
TYPEREF(N) ;
+1 NEW %
SET %=$PIECE(^AUPNPREF(N,0),U,7)
+2 IF %="R"!(%="")
QUIT "Declined"
+3 IF %="N"
QUIT "Not Med Ind"
+4 IF %="F"
QUIT "No Resp to F/U"
+5 QUIT ""
+6 ;
+7 ;
GETLABSX ;get lab tests ordered today
+1 ;
+2 SET APCHLR=$GET(^DPT(APCHSDFN,"LR"))
+3 IF $GET(APCHLR)]""
SET APCHLRO=0
SET APCHTSTP=0
Begin DoDot:1
+4 FOR
SET APCHLRO=$ORDER(^LRO(69,DT,1,"AA",APCHLR,APCHLRO))
IF APCHLRO=""
QUIT
IF APCHLRO'=+APCHLRO
QUIT
Begin DoDot:2
+5 FOR
SET APCHTSTP=$ORDER(^LRO(69,DT,1,APCHLRO,2,"B",APCHTSTP))
IF APCHTSTP'=+APCHTSTP
QUIT
Begin DoDot:3
+6 SET APCHTCTR=$ORDER(^LRO(69,DT,1,APCHLRO,2,"B",APCHTSTP,0))
+7 SET APCHTEST=$PIECE(^LAB(60,APCHTSTP,0),U)
+8 SET APCHTST(APCHTEST)=""
+9 QUIT
End DoDot:3
End DoDot:2
End DoDot:1
+10 ;
+11 ;
GETLABS ;get todays labs from V Lab File
+1 SET APCHSIVD=9999999-DT
+2 IF $DATA(^AUPNVLAB("AE",APCHSDFN,APCHSIVD))
SET APCHTSTP=0
SET APCHVLAB=0
Begin DoDot:1
+3 FOR
SET APCHTSTP=$ORDER(^AUPNVLAB("AE",APCHSDFN,APCHSIVD,APCHTSTP))
IF APCHTSTP=""
QUIT
IF APCHTSTP'=+APCHTSTP
QUIT
Begin DoDot:2
+4 SET APCHTEST=$PIECE(^LAB(60,APCHTSTP,0),U)
SET APCHTST(APCHTEST)=""
+5 SET APCHVLAB=$ORDER(^AUPNVLAB("AE",APCHSDFN,APCHSIVD,APCHTSTP,APCHVLAB))
IF APCHVLAB'=+APCHVLAB
QUIT
+6 IF $DATA(^AUPNVLAB(APCHVLAB,21))
SET APCHCTR=0
FOR
SET APCHCTR=$ORDER(^AUPNVLAB(APCHVLAB,21,APCHCTR))
IF 'APCHCTR
QUIT
Begin DoDot:3
+7 IF APCHCTR'=+APCHCTR
QUIT
+8 SET APCHTST(APCHTEST,APCHCTR)=$PIECE(^AUPNVLAB(APCHVLAB,21,APCHCTR,0),U)
End DoDot:3
+9 QUIT
End DoDot:2
End DoDot:1
+10 QUIT
+11 ;
APCHLHD ;
+1 SET X="Lab tests can help measure health and some check to make sure that your"
DO S(X,1)
+2 SET X="medicines are working right."
DO S(X)
+3 ;
