BHSPMH3 ;IHS/MSC/MGH - Health Summary for Patient wellness handout ;30-Nov-2015 10:27;DU
;;1.0;HEALTH SUMMARY COMPONENTS;**1,2,12**;March 17,2006;Build 3
;===================================================================
;Taken from APCHPMH1 routine
;p12 changed to use new API for taxonomies
;
EP(BHSDFN) ;PEP - PASS DFN get back array of patient care summary
;at this point you are stuck with ^TMP("BHSPHS",$J,"PMH"
K ^TMP("BHSPHS",$J,"PMH")
S ^TMP("BHSPHS",$J,"PMH",0)=0
N BHSVSIT,BHSPROV,X,Y
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="Report Date: "_GMTSDTM D S(X)
S X=$P($P(^DPT(BHSDFN,0),U),",",2)_" "_$P($P(^DPT(BHSDFN,0),U),",")_" HRN: "_$$HRN^AUPNPAT(BHSDFN,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(BHSVSIT)]"",$D(^AUPNVSIT("AC",BHSDFN,BHSVSIT)) S BHSPROV=$$PRIMPROV^APCLV(BHSVSIT)
S X=$$VAL^XBDIQ1(2,BHSDFN,.111),$E(X,50)=$S($G(BHSPROV)]"":BHSPROV,1:$$VAL^XBDIQ1(9000001,BHSDFN,.14)) D S(X) ;GARY - ADD CHECK FOR CURRENT VISIT PROVIDER
S X=$$VAL^XBDIQ1(2,BHSDFN,.114)_$S($$VAL^XBDIQ1(2,BHSDFN,.114)]"":", ",1:" ")_$$VAL^XBDIQ1(2,BHSDFN,.115)_" "_$$VAL^XBDIQ1(2,BHSDFN,.116),Y=$P(^AUTTLOC(DUZ(2),0),U,11),$E(X,50)=Y D S(X)
S X=$$VAL^XBDIQ1(2,BHSDFN,.131) D S(X)
S X="Hello "_$S($$SEX^AUPNPAT(BHSDFN)="M":"Mr. ",1:"Ms. ")_$E($P($P(^DPT(BHSDFN,0),U),","))_$$LOW^XLFSTR($E($P($P(^DPT(BHSDFN,0),U),","),2,99))_"," D S(X,1)
S X="Thank you for choosing "_$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,1)
S X="This sheet is a new way for you and your doctor to look at your health." D S(X,1)
IMMUN ;
N APCHIMM,APCHIMMT,APCHIMMN,X,APCHI,APCHICTR,APCHIMDU
S X="Immunizations(shots). Getting shots protects you from some diseases and" D S(X,1)
S X="illnesses." D S(X)
D IMMFORC^BIRPC(.APCHIMM,BHSDFN)
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 $D(APCHI) S APCHICTR=0 D
.F S APCHICTR=$O(APCHI(APCHICTR)) Q:'APCHICTR D
..Q:$L(APCHI(APCHICTR))<3
..S APCHIMDU=APCHICTR
.I +$G(APCHIMDU)>0 S X=APCHIMDU_$S(APCHIMDU>1:" Immunizations Due:",1:" Immunization Due") D S(X,1)
.F I=1:1:APCHIMDU S X="",$E(X,5)=APCHI(I) D S(X)
.Q
;
MEAS ;
N BHSX,APCHFEET,APCHINCH,X,APCHSBP,APCHDBP,APCHHBP,E,H,W
S X="Weight is a good measure of health - and it depends on how tall you are." D S(X,1)
D GETHWBBP(BHSDFN)
;Convert BHSX("HT") to ft & inches
I $G(BHSX("HT"))]"" S APCHFEET=BHSX("HT")/12,APCHINCH=$P(APCHFEET,".",2),APCHINCH="."_APCHINCH*12,APCHINCH=$J(APCHINCH,2,0),APCHFEET=$P(APCHFEET,".")
I $G(BHSX("HT"))]"" S X="",$E(X,5)="You are "_APCHFEET_" feet and "_APCHINCH_" inches tall." D S(X)
;
I $G(BHSX("WT"))="" S X="",$E(X,5)="No weight on file." D S(X)
I $G(BHSX("HT"))']"" S X="",$E(X,5)="No height on file." D S(X)
I $G(BHSX("WT"))]"" S X="",$E(X,5)="Your last weight was "_$J(BHSX("WT"),3,0)_" pounds on "_$$FMTE^XLFDT(BHSX("WTD"))_"." D S(X)
I $G(BHSX("WT"))]"",$$FMDIFF^XLFDT(DT,BHSX("WTD"))>120 S X="",$E(X,5)="You should have your weight rechecked at your next visit" D S(X)
I $G(BHSX("WTD"))]"",BHSX("WTD")=DT,$G(BHSX("BMI"))]"" D
.S X="",$E(X,5)="Your Body Mass Index today was "_BHSX("BMI")_". This is a good way to" D S(X)
.S X="",$E(X,5)="compare your height and weight." D S(X)
.Q
I $G(BHSX("WTD"))]"",BHSX("WTD")<DT,$G(BHSX("BMI"))]"" D
.S X="",$E(X,5)="Your Body Mass Index on "_$$FMTE^XLFDT(BHSX("WTD"))_" was "_BHSX("BMI")_"." D S(X)
.Q
I $G(BHSX("BMI"))]"",BHSX("BMI")<25 S X="",$E(X,5)="You are at a healthy weight. Keep up the good work!" D S(X)
I BHSX("BMI")>26 D
.S X="",$E(X,5)="You are above a healthy weight. Too much weight can lead to lots" D S(X)
.S X="",$E(X,5)="of health problems - diabetes, heart disease, back pain, leg pains," D S(X)
.S X="",$E(X,5)="and more. Ask your provider about things you can do to fix your weight." D S(X)
.Q
;
I $G(BHSX("BP"))]"" S APCHSBP=$P(BHSX("BP"),"/"),APCHDBP=$P(BHSX("BP"),"/",2),X="Blood pressure is a good measure of health." D S(X,1)
I $G(BHSX("BP"))]"" S X="",$E(X,5)="Your last blood pressure was "_APCHSBP_" over "_APCHDBP_" on "_$$FMTE^XLFDT(BHSX("BPD"))_"." D S(X) D
.I $$AGE^AUPNPAT(BHSDFN)>21,$$FMDIFF^XLFDT(DT,BHSX("BPD"))>365 S X="",$E(X,5)="You should have your blood pressure checked at your next visit." D S(X)
.I $$AGE^AUPNPAT(BHSDFN)>3,$$AGE^AUPNPAT(BHSDFN)<22,$$FMDIFF^XLFDT(DT,BHSX("BPD"))>720 S X="You should have your blood pressure checked at your next visit" D S(X)
.Q
I $$AGE^AUPNPAT(BHSDFN)>21,$G(BHSX("BP"))']"" S X="Blood pressure is a good measure of health." D S(X,1) S X="",$E(X,5)="You should have your blood pressure checked at your next visit." D S(X)
I $$AGE^AUPNPAT(BHSDFN)>3,$$AGE^AUPNPAT(BHSDFN)<22,$G(BHSX("BP"))']"" S X="Blood pressure is a good measure of health." D S(X,1) S X="",$E(X,5)="You should have your blood pressure checked at your next visit." D S(X)
CKDP ;
;does pt have chronic kidney disease?
D CKD
I $G(BHSX("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(BHSDFN)="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)
;
ALLERG ;
S X="Allergies, reactions that you've had to medicines or other things are very" D S(X,1)
S X="important. Below are the allergies that we know. If anything is wrong or" D S(X)
S X="missing, please let your provider know." D S(X)
S X="" D S(X)
N APCHENT,APCHSPT,APCHALG,APCHSALD,APCHSALP,APCHSAPR,APCHSALG,APCHSP
S APCHSALD=0,APCHSALP=0,APCHSALG=0
D EN^APCHPALG ;get allergies from allergy tracking and problem list
;I $D(APCHENT) S X="",$E(X,5)="From Allergy Tracking System:",$E(X,45)="(v)=verified (u)=unverified" D S(X)
I $D(APCHENT) S X="",$E(X,5)="From Allergy Tracking System:" D S(X)
I $D(APCHENT("A")) F S APCHSALD=$O(APCHENT("A",APCHSALD)) Q:APCHSALD'=+APCHSALD D
.Q:$G(APCHSALD)']""
.F I $D(APCHENT("A")) S APCHSALP=$O(APCHENT("A",APCHSALD,APCHSALP)) Q:APCHSALP="" Q:APCHSALD'=+APCHSALD D
..S APCHSALG=1
..S X="",$E(X,5)=$G(APCHENT("A",APCHSALD,APCHSALP)) D S(X)
..Q
I $D(APCHENT("P")) F S APCHSALD=$O(APCHENT("P",APCHSALD)) Q:APCHSALD'=+APCHSALD D
.Q:$G(APCHSALD)']""
.F I $D(APCHENT("P")) S APCHSALP=$O(APCHENT("P",APCHSALD,APCHSALP)) Q:APCHSALP="" Q:APCHSALD'=+APCHSALD D
..S APCHSALG=1
..S X="",$E(X,5)=$G(APCHENT("P",APCHSALD,APCHSALP)) D S(X)
..Q
I $D(APCHENT("U")) F S APCHSALD=$O(APCHENT("U",APCHSALD)) Q:APCHSALD'=+APCHSALD D
.Q:$G(APCHSALD)']""
.F I $D(APCHENT("U")) S APCHSALP=$O(APCHENT("U",APCHSALD,APCHSALP)) Q:APCHSALP="" Q:APCHSALD'=+APCHSALD D
..S APCHSALG=1
..S X="",$E(X,5)=$G(APCHENT("A",APCHSALD,APCHSALP)) D S(X)
..Q
;
S APCHSALD=0,APCHSALP=0,APCHSAPR=0
D PROBA^APCHPALG ;get allergies from Problem List
I $D(APCHSPT) S X="",$E(X,5)="From Problem List" D S(X,1)
I $D(APCHSPT) F S APCHSALD=$O(APCHSPT(APCHSALD)) Q:APCHSALD'=+APCHSALD D
.S APCHSALP=$O(APCHSPT(APCHSALP))
.Q:APCHSALP'=+APCHSALP
.S APCHSAPR=1
.S X="",$E(X,5)=$G(APCHSPT(APCHSALP)) D S(X)
.Q
I APCHSALG=0,APCHSAPR=0 S X="",$E(X,5)="No allergies on file." D S(X)
MEDS ;
N X,APCHSDLM,APCHSIVD,APCHSMCT,APCHSM,APCHSMED,APCHSIG,APCHSMX,APCHSMCT,APCHSQ,APCHSSGY
N J,APCHMFX,APCHSMFX,APCHLUPD,APCHHM,APCHHMED
S X="Medicines are important - it helps to know" D S(X,1)
S X="",$E(X,5)="Why you will take it?" D S(X)
S X="",$E(X,5)="When to take it?" D S(X)
S X="",$E(X,5)="How much to take?" D S(X)
S X="",$E(X,5)="What to do if you forget to take it?" D S(X)
S X="",$E(X,5)="What could happen if you forget or take too much." D S(X)
S X="Knowing these things will help the medicine work best for you." D S(X)
S X="Here is a list of the medicines you are taking:" D S(X)
S X="" D S(X)
;
;get all "active" meds
S APCHSDLM=$$FMADD^XLFDT(DT,-365),APCHSDLM=9999999-APCHSDLM
S APCHSIVD=0,APCHSMCT=0 F APCHSQ=0:0 S APCHSIVD=$O(^AUPNVMED("AA",BHSDFN,APCHSIVD)) Q:APCHSIVD=""!(APCHSIVD>APCHSDLM) S APCHSMX=0 F APCHSQ=0:0 S APCHSMX=$O(^AUPNVMED("AA",BHSDFN,APCHSIVD,APCHSMX)) Q:APCHSMX="" D MEDBLD^BHSPMH1A
I $G(APCHSMCT)=0 S X="",$E(X,5)="No current meds on file" D S(X)
S APCHSMED=""
F S APCHSMED=$O(APCHSM(APCHSMED)) Q:$G(APCHSMED)']"" D
.S X="",$E(X,5)=APCHSMED D S(X)
.;S X="",$E(X,7)="Directions: "_$P($G(APCHSM(APCHSMED)),U,5) D S(X) ;sig
.K ^UTILITY($J,"W") S APCHSIG=$P($G(APCHSM(APCHSMED)),U,5),X=APCHSIG,DIWL=0,DIWR=58 D ^DIWP
.S X="",$E(X,7)="Directions: "_$G(^UTILITY($J,"W",0,1,0)) D S(X)
.I $G(^UTILITY($J,"W",0))>1 F I=2:1:$G(^UTILITY($J,"W",0)) S X="",$E(X,7)=$G(^UTILITY($J,"W",0,I,0)) D S(X)
.K ^UTILITY($J,"W")
.Q
D HOLD
I '$D(APCHHM) Q
S X="Medications ordered, but not yet dispensed" D S(X,1)
S X="" D S(X)
S APCHHMED=""
F S APCHHMED=$O(APCHHM(APCHHMED)) Q:$G(APCHHMED)']"" D
.S X="",$E(X,5)=APCHHMED D S(X)
Q
CKD ;Does patient have chronic kidney disease (CKD)?
N APCHCKD,APCHLUPV,APCHLACV,APCHLEGV,APCHLACD,APCHLCRD,APCHLCRV,APCHLEGD
S APCHCKD=0
;get last serum creatinine value
S T=$O(^ATXLAB("B","DM AUDIT CREATININE TAX",0)) I $G(T)]"" S APCHLCRV=$$LAB^BHSPMH2(BHSDFN,T),APCHLCRD=$P($G(APCHLCRV),"|||",2),APCHLCRV=$P($G(APCHLCRV),"|||") I $G(APCHLCRV)]"" D
.I $$SEX^AUPNPAT(BHSDFN)="F",APCHLCRV>1.3 S APCHCKD=1
.I $$SEX^AUPNPAT(BHSDFN)="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^BHSPMH2(BHSDFN,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^BHSPMH2(BHSDFN,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^BHSPMH2(BHSDFN,T),APCHLEGD=$P($G(APCHLEGV),"|||",2),APCHLEGV=$P($G(APCHLEGV),"|||") I $G(APCHLEGV)]"" D
.I APCHLEGV<60 S APCHCKD=1
Q
;
RXSTAT ; EP gets status of rx ... TAKEN FROM PSOFUNC ROUTINE
Q:$D(^PSRX(APCHSRXP,"STA")) ;USING V7
Q:$G(APCHSRXP)'>0
S J=APCHSRXP
S ST0=+$P(RX0,"^",15) I ST0<12,$O(^PS(52.5,"B",J,0)),$D(^PS(52.5,+$O(^(0)),0)),'$G(^("P")) S ST0=5
I ST0<12,$P(RX2,"^",6),$P(RX2,"^",6)'>DT S ST0=11
S ST=$P("ERROR^ACTIVE^NON-VERIFIED^REFILL FILL^HOLD^PENDING DUE TO DRUG INTERACTION^SUSPENDED^^^^^DONE^EXPIRED^CANCELLED^DELETED","^",ST0+2),$P(RX0,"^",15)=ST0
Q
;
;
HOLD ;Now get meds in Pharmacy yet to be completed
Q:'BHSDFN
N APCHNMED,APCHSDT
S APCHSDT=DT
F S APCHSDT=$O(^PS(55,BHSDFN,"P","A",APCHSDT)) Q:APCHSDT'=+APCHSDT D
.S APCHNMED=0 F S APCHNMED=$O(^PS(55,BHSDFN,"P","A",APCHSDT,APCHNMED)) Q:'APCHNMED D
..I $G(^PSRX(APCHNMED,"STA"))=3!($G(^PSRX(APCHNMED,"STA"))=5) D
...S APCHHMED=$P(^PSRX(APCHNMED,0),U,6) I $G(APCHHMED)]"" S APCHHMED=$P(^PSDRUG(APCHHMED,0),U)
...S APCHHM(APCHHMED)=APCHNMED
..Q
Q
;
S(Y,F,C,T) ;set up array
I '$G(F) S F=0
I '$G(T) S T=0
NEW %,X,L
;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("BHSPHS",$J,"PMH",0),U)+1,$P(^TMP("BHSPHS",$J,"PMH",0),U)=%
S ^TMP("BHSPHS",$J,"PMH",%)=X
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)
GETHWBBP(P) ;get last height, height date, weight, weight date, BMI and BP for patient P, return in BHSX("HT"),BHSX("HTD"),BHSX("WT"),BHSX("WTD"),BHSX("BMI")
K BHSX
S BHSX("HT")="",BHSX("HTD")="",BHSX("WT")="",BHSX("WTD")="",BHSX("BMI")="",BHSX("WC")="",BHSX("WCD")=""
LASTHT ;
Q:'$D(^AUPNVSIT("AC",P))
Q:'$D(^AUPNVMSR("AC",P))
NEW BHSY
S %=P_"^LAST MEAS HT" NEW X S E=$$START1^APCLDF(%,"BHSY(") S BHSX("HT")=$P($G(BHSY(1)),U,2),BHSX("HTD")=$P($G(BHSY(1)),U)
S BHSX("HT")=$S(BHSX("HT")]"":$J(BHSX("HT"),2,0),1:"")
LASTWT ;
K BHSY S %=P_"^LAST MEAS WT" NEW X S E=$$START1^APCLDF(%,"BHSY(") S BHSX("WT")=$P($G(BHSY(1)),U,2),BHSX("WTD")=$P($G(BHSY(1)),U)
LASTBP ;
K BHSY S %=P_"^LAST MEAS BP" NEW X S E=$$START1^APCLDF(%,"BHSY(") S BHSX("BP")=$P($G(BHSY(1)),U,2),BHSX("BPD")=$P($G(BHSY(1)),U)
LASTWC ;
K BHSY S %=P_"^LAST MEAS WC" NEW X S E=$$START1^APCLDF(%,"BHSY(") S BHSX("WC")=$P($G(BHSY(1)),U,2),BHSX("WCD")=$P($G(BHSY(1)),U)
BMI ;
I $$AGE^AUPNPAT(P)<19,(BHSX("WTD")'=BHSX("HTD")) Q
I BHSX("WT")=""!('BHSX("HT")) Q
S %=""
S W=BHSX("WT")*.45359,H=(BHSX("HT")*0.0254),H=(H*H),%=(W/H),%=$J(%,4,1)
S BHSX("BMI")=%
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) D
.I $D(^AUPNPROB(X,0)) S Y=$P(^AUPNPROB(X,0),U) I $$ICD^ATXCHK(Y,T,9) S I=1
I I Q "Yes"
NEW BHSX
S BHSX=""
S X=P_"^LAST 3 DX [SURVEILLANCE DIABETES" S E=$$START1^APCLDF(X,"BHSX(") G:E DMX I $D(BHSX(3)) S BHSX="Yes"
I $G(BHSX)="" S BHSX="No"
DMX ;
Q BHSX
;
BHSPMH3 ;IHS/MSC/MGH - Health Summary for Patient wellness handout ;30-Nov-2015 10:27;DU
+1 ;;1.0;HEALTH SUMMARY COMPONENTS;**1,2,12**;March 17,2006;Build 3
+2 ;===================================================================
+3 ;Taken from APCHPMH1 routine
+4 ;p12 changed to use new API for taxonomies
+5 ;
EP(BHSDFN) ;PEP - PASS DFN get back array of patient care summary
+1 ;at this point you are stuck with ^TMP("BHSPHS",$J,"PMH"
+2 KILL ^TMP("BHSPHS",$JOB,"PMH")
+3 SET ^TMP("BHSPHS",$JOB,"PMH",0)=0
+4 NEW BHSVSIT,BHSPROV,X,Y
+5 DO SETARRAY
+6 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="Report Date: "_GMTSDTM
DO S(X)
+4 SET X=$PIECE($PIECE(^DPT(BHSDFN,0),U),",",2)_" "_$PIECE($PIECE(^DPT(BHSDFN,0),U),",")_" HRN: "_$$HRN^AUPNPAT(BHSDFN,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(BHSVSIT)]""
IF $DATA(^AUPNVSIT("AC",BHSDFN,BHSVSIT))
SET BHSPROV=$$PRIMPROV^APCLV(BHSVSIT)
+6 ;GARY - ADD CHECK FOR CURRENT VISIT PROVIDER
SET X=$$VAL^XBDIQ1(2,BHSDFN,.111)
SET $EXTRACT(X,50)=$SELECT($GET(BHSPROV)]"":BHSPROV,1:$$VAL^XBDIQ1(9000001,BHSDFN,.14))
DO S(X)
+7 SET X=$$VAL^XBDIQ1(2,BHSDFN,.114)_$SELECT($$VAL^XBDIQ1(2,BHSDFN,.114)]"":", ",1:" ")_$$VAL^XBDIQ1(2,BHSDFN,.115)_" "_$$VAL^XBDIQ1(2,BHSDFN,.116)
SET Y=$PIECE(^AUTTLOC(DUZ(2),0),U,11)
SET $EXTRACT(X,50)=Y
DO S(X)
+8 SET X=$$VAL^XBDIQ1(2,BHSDFN,.131)
DO S(X)
+9 SET X="Hello "_$SELECT($$SEX^AUPNPAT(BHSDFN)="M":"Mr. ",1:"Ms. ")_$EXTRACT($PIECE($PIECE(^DPT(BHSDFN,0),U),","))_$$LOW^XLFSTR($EXTRACT($PIECE($PIECE(^DPT(BHSDFN,0),U),","),2,99))_","
DO S(X,1)
+10 SET X="Thank you for choosing "_$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,1)
+11 SET X="This sheet is a new way for you and your doctor to look at your health."
DO S(X,1)
IMMUN ;
+1 NEW APCHIMM,APCHIMMT,APCHIMMN,X,APCHI,APCHICTR,APCHIMDU
+2 SET X="Immunizations(shots). Getting shots protects you from some diseases and"
DO S(X,1)
+3 SET X="illnesses."
DO S(X)
+4 DO IMMFORC^BIRPC(.APCHIMM,BHSDFN)
+5 IF $EXTRACT($GET(APCHIMM),1,2)="No"
SET X=""
SET $EXTRACT(X,5)="You have all your immunizations. That's Great!"
DO S(X)
+6 IF $EXTRACT($GET(APCHIMM),1,2)=" "
FOR APCHIMMN=1:1
SET APCHIMMT=$PIECE($PIECE(APCHIMM,U,APCHIMMN),"|")
IF $GET(APCHIMMT)']""
QUIT
Begin DoDot:1
+7 IF $EXTRACT(APCHIMMT,1,2)=" "
SET APCHIMMT=$EXTRACT(APCHIMMT,3,99)
+8 IF $GET(APCHIMMT)]""
SET APCHI(APCHIMMN)=APCHIMMT
+9 QUIT
End DoDot:1
+10 IF $DATA(APCHI)
SET APCHICTR=0
Begin DoDot:1
+11 FOR
SET APCHICTR=$ORDER(APCHI(APCHICTR))
IF 'APCHICTR
QUIT
Begin DoDot:2
+12 IF $LENGTH(APCHI(APCHICTR))<3
QUIT
+13 SET APCHIMDU=APCHICTR
End DoDot:2
+14 IF +$GET(APCHIMDU)>0
SET X=APCHIMDU_$SELECT(APCHIMDU>1:" Immunizations Due:",1:" Immunization Due")
DO S(X,1)
+15 FOR I=1:1:APCHIMDU
SET X=""
SET $EXTRACT(X,5)=APCHI(I)
DO S(X)
+16 QUIT
End DoDot:1
+17 ;
MEAS ;
+1 NEW BHSX,APCHFEET,APCHINCH,X,APCHSBP,APCHDBP,APCHHBP,E,H,W
+2 SET X="Weight is a good measure of health - and it depends on how tall you are."
DO S(X,1)
+3 DO GETHWBBP(BHSDFN)
+4 ;Convert BHSX("HT") to ft & inches
+5 IF $GET(BHSX("HT"))]""
SET APCHFEET=BHSX("HT")/12
SET APCHINCH=$PIECE(APCHFEET,".",2)
SET APCHINCH="."_APCHINCH*12
SET APCHINCH=$JUSTIFY(APCHINCH,2,0)
SET APCHFEET=$PIECE(APCHFEET,".")
+6 IF $GET(BHSX("HT"))]""
SET X=""
SET $EXTRACT(X,5)="You are "_APCHFEET_" feet and "_APCHINCH_" inches tall."
DO S(X)
+7 ;
+8 IF $GET(BHSX("WT"))=""
SET X=""
SET $EXTRACT(X,5)="No weight on file."
DO S(X)
+9 IF $GET(BHSX("HT"))']""
SET X=""
SET $EXTRACT(X,5)="No height on file."
DO S(X)
+10 IF $GET(BHSX("WT"))]""
SET X=""
SET $EXTRACT(X,5)="Your last weight was "_$JUSTIFY(BHSX("WT"),3,0)_" pounds on "_$$FMTE^XLFDT(BHSX("WTD"))_"."
DO S(X)
+11 IF $GET(BHSX("WT"))]""
IF $$FMDIFF^XLFDT(DT,BHSX("WTD"))>120
SET X=""
SET $EXTRACT(X,5)="You should have your weight rechecked at your next visit"
DO S(X)
+12 IF $GET(BHSX("WTD"))]""
IF BHSX("WTD")=DT
IF $GET(BHSX("BMI"))]""
Begin DoDot:1
+13 SET X=""
SET $EXTRACT(X,5)="Your Body Mass Index today was "_BHSX("BMI")_". This is a good way to"
DO S(X)
+14 SET X=""
SET $EXTRACT(X,5)="compare your height and weight."
DO S(X)
+15 QUIT
End DoDot:1
+16 IF $GET(BHSX("WTD"))]""
IF BHSX("WTD")<DT
IF $GET(BHSX("BMI"))]""
Begin DoDot:1
+17 SET X=""
SET $EXTRACT(X,5)="Your Body Mass Index on "_$$FMTE^XLFDT(BHSX("WTD"))_" was "_BHSX("BMI")_"."
DO S(X)
+18 QUIT
End DoDot:1
+19 IF $GET(BHSX("BMI"))]""
IF BHSX("BMI")<25
SET X=""
SET $EXTRACT(X,5)="You are at a healthy weight. Keep up the good work!"
DO S(X)
+20 IF BHSX("BMI")>26
Begin DoDot:1
+21 SET X=""
SET $EXTRACT(X,5)="You are above a healthy weight. Too much weight can lead to lots"
DO S(X)
+22 SET X=""
SET $EXTRACT(X,5)="of health problems - diabetes, heart disease, back pain, leg pains,"
DO S(X)
+23 SET X=""
SET $EXTRACT(X,5)="and more. Ask your provider about things you can do to fix your weight."
DO S(X)
+24 QUIT
End DoDot:1
+25 ;
+26 IF $GET(BHSX("BP"))]""
SET APCHSBP=$PIECE(BHSX("BP"),"/")
SET APCHDBP=$PIECE(BHSX("BP"),"/",2)
SET X="Blood pressure is a good measure of health."
DO S(X,1)
+27 IF $GET(BHSX("BP"))]""
SET X=""
SET $EXTRACT(X,5)="Your last blood pressure was "_APCHSBP_" over "_APCHDBP_" on "_$$FMTE^XLFDT(BHSX("BPD"))_"."
DO S(X)
Begin DoDot:1
+28 IF $$AGE^AUPNPAT(BHSDFN)>21
IF $$FMDIFF^XLFDT(DT,BHSX("BPD"))>365
SET X=""
SET $EXTRACT(X,5)="You should have your blood pressure checked at your next visit."
DO S(X)
+29 IF $$AGE^AUPNPAT(BHSDFN)>3
IF $$AGE^AUPNPAT(BHSDFN)<22
IF $$FMDIFF^XLFDT(DT,BHSX("BPD"))>720
SET X="You should have your blood pressure checked at your next visit"
DO S(X)
+30 QUIT
End DoDot:1
+31 IF $$AGE^AUPNPAT(BHSDFN)>21
IF $GET(BHSX("BP"))']""
SET X="Blood pressure is a good measure of health."
DO S(X,1)
SET X=""
SET $EXTRACT(X,5)="You should have your blood pressure checked at your next visit."
DO S(X)
+32 IF $$AGE^AUPNPAT(BHSDFN)>3
IF $$AGE^AUPNPAT(BHSDFN)<22
IF $GET(BHSX("BP"))']""
SET X="Blood pressure is a good measure of health."
DO S(X,1)
SET X=""
SET $EXTRACT(X,5)="You should have your blood pressure checked at your next visit."
DO S(X)
CKDP ;
+1 ;does pt have chronic kidney disease?
+2 DO CKD
+3 IF $GET(BHSX("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(BHSDFN)="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 ;
ALLERG ;
+1 SET X="Allergies, reactions that you've had to medicines or other things are very"
DO S(X,1)
+2 SET X="important. Below are the allergies that we know. If anything is wrong or"
DO S(X)
+3 SET X="missing, please let your provider know."
DO S(X)
+4 SET X=""
DO S(X)
+5 NEW APCHENT,APCHSPT,APCHALG,APCHSALD,APCHSALP,APCHSAPR,APCHSALG,APCHSP
+6 SET APCHSALD=0
SET APCHSALP=0
SET APCHSALG=0
+7 ;get allergies from allergy tracking and problem list
DO EN^APCHPALG
+8 ;I $D(APCHENT) S X="",$E(X,5)="From Allergy Tracking System:",$E(X,45)="(v)=verified (u)=unverified" D S(X)
+9 IF $DATA(APCHENT)
SET X=""
SET $EXTRACT(X,5)="From Allergy Tracking System:"
DO S(X)
+10 IF $DATA(APCHENT("A"))
FOR
SET APCHSALD=$ORDER(APCHENT("A",APCHSALD))
IF APCHSALD'=+APCHSALD
QUIT
Begin DoDot:1
+11 IF $GET(APCHSALD)']""
QUIT
+12 FOR
IF $DATA(APCHENT("A"))
SET APCHSALP=$ORDER(APCHENT("A",APCHSALD,APCHSALP))
IF APCHSALP=""
QUIT
IF APCHSALD'=+APCHSALD
QUIT
Begin DoDot:2
+13 SET APCHSALG=1
+14 SET X=""
SET $EXTRACT(X,5)=$GET(APCHENT("A",APCHSALD,APCHSALP))
DO S(X)
+15 QUIT
End DoDot:2
End DoDot:1
+16 IF $DATA(APCHENT("P"))
FOR
SET APCHSALD=$ORDER(APCHENT("P",APCHSALD))
IF APCHSALD'=+APCHSALD
QUIT
Begin DoDot:1
+17 IF $GET(APCHSALD)']""
QUIT
+18 FOR
IF $DATA(APCHENT("P"))
SET APCHSALP=$ORDER(APCHENT("P",APCHSALD,APCHSALP))
IF APCHSALP=""
QUIT
IF APCHSALD'=+APCHSALD
QUIT
Begin DoDot:2
+19 SET APCHSALG=1
+20 SET X=""
SET $EXTRACT(X,5)=$GET(APCHENT("P",APCHSALD,APCHSALP))
DO S(X)
+21 QUIT
End DoDot:2
End DoDot:1
+22 IF $DATA(APCHENT("U"))
FOR
SET APCHSALD=$ORDER(APCHENT("U",APCHSALD))
IF APCHSALD'=+APCHSALD
QUIT
Begin DoDot:1
+23 IF $GET(APCHSALD)']""
QUIT
+24 FOR
IF $DATA(APCHENT("U"))
SET APCHSALP=$ORDER(APCHENT("U",APCHSALD,APCHSALP))
IF APCHSALP=""
QUIT
IF APCHSALD'=+APCHSALD
QUIT
Begin DoDot:2
+25 SET APCHSALG=1
+26 SET X=""
SET $EXTRACT(X,5)=$GET(APCHENT("A",APCHSALD,APCHSALP))
DO S(X)
+27 QUIT
End DoDot:2
End DoDot:1
+28 ;
+29 SET APCHSALD=0
SET APCHSALP=0
SET APCHSAPR=0
+30 ;get allergies from Problem List
DO PROBA^APCHPALG
+31 IF $DATA(APCHSPT)
SET X=""
SET $EXTRACT(X,5)="From Problem List"
DO S(X,1)
+32 IF $DATA(APCHSPT)
FOR
SET APCHSALD=$ORDER(APCHSPT(APCHSALD))
IF APCHSALD'=+APCHSALD
QUIT
Begin DoDot:1
+33 SET APCHSALP=$ORDER(APCHSPT(APCHSALP))
+34 IF APCHSALP'=+APCHSALP
QUIT
+35 SET APCHSAPR=1
+36 SET X=""
SET $EXTRACT(X,5)=$GET(APCHSPT(APCHSALP))
DO S(X)
+37 QUIT
End DoDot:1
+38 IF APCHSALG=0
IF APCHSAPR=0
SET X=""
SET $EXTRACT(X,5)="No allergies on file."
DO S(X)
MEDS ;
+1 NEW X,APCHSDLM,APCHSIVD,APCHSMCT,APCHSM,APCHSMED,APCHSIG,APCHSMX,APCHSMCT,APCHSQ,APCHSSGY
+2 NEW J,APCHMFX,APCHSMFX,APCHLUPD,APCHHM,APCHHMED
+3 SET X="Medicines are important - it helps to know"
DO S(X,1)
+4 SET X=""
SET $EXTRACT(X,5)="Why you will take it?"
DO S(X)
+5 SET X=""
SET $EXTRACT(X,5)="When to take it?"
DO S(X)
+6 SET X=""
SET $EXTRACT(X,5)="How much to take?"
DO S(X)
+7 SET X=""
SET $EXTRACT(X,5)="What to do if you forget to take it?"
DO S(X)
+8 SET X=""
SET $EXTRACT(X,5)="What could happen if you forget or take too much."
DO S(X)
+9 SET X="Knowing these things will help the medicine work best for you."
DO S(X)
+10 SET X="Here is a list of the medicines you are taking:"
DO S(X)
+11 SET X=""
DO S(X)
+12 ;
+13 ;get all "active" meds
+14 SET APCHSDLM=$$FMADD^XLFDT(DT,-365)
SET APCHSDLM=9999999-APCHSDLM
+15 SET APCHSIVD=0
SET APCHSMCT=0
FOR APCHSQ=0:0
SET APCHSIVD=$ORDER(^AUPNVMED("AA",BHSDFN,APCHSIVD))
IF APCHSIVD=""!(APCHSIVD>APCHSDLM)
QUIT
SET APCHSMX=0
FOR APCHSQ=0:0
SET APCHSMX=$ORDER(^AUPNVMED("AA",BHSDFN,APCHSIVD,APCHSMX))
IF APCHSMX=""
QUIT
DO MEDBLD^BHSPMH1A
+16 IF $GET(APCHSMCT)=0
SET X=""
SET $EXTRACT(X,5)="No current meds on file"
DO S(X)
+17 SET APCHSMED=""
+18 FOR
SET APCHSMED=$ORDER(APCHSM(APCHSMED))
IF $GET(APCHSMED)']""
QUIT
Begin DoDot:1
+19 SET X=""
SET $EXTRACT(X,5)=APCHSMED
DO S(X)
+20 ;S X="",$E(X,7)="Directions: "_$P($G(APCHSM(APCHSMED)),U,5) D S(X) ;sig
+21 KILL ^UTILITY($JOB,"W")
SET APCHSIG=$PIECE($GET(APCHSM(APCHSMED)),U,5)
SET X=APCHSIG
SET DIWL=0
SET DIWR=58
DO ^DIWP
+22 SET X=""
SET $EXTRACT(X,7)="Directions: "_$GET(^UTILITY($JOB,"W",0,1,0))
DO S(X)
+23 IF $GET(^UTILITY($JOB,"W",0))>1
FOR I=2:1:$GET(^UTILITY($JOB,"W",0))
SET X=""
SET $EXTRACT(X,7)=$GET(^UTILITY($JOB,"W",0,I,0))
DO S(X)
+24 KILL ^UTILITY($JOB,"W")
+25 QUIT
End DoDot:1
+26 DO HOLD
+27 IF '$DATA(APCHHM)
QUIT
+28 SET X="Medications ordered, but not yet dispensed"
DO S(X,1)
+29 SET X=""
DO S(X)
+30 SET APCHHMED=""
+31 FOR
SET APCHHMED=$ORDER(APCHHM(APCHHMED))
IF $GET(APCHHMED)']""
QUIT
Begin DoDot:1
+32 SET X=""
SET $EXTRACT(X,5)=APCHHMED
DO S(X)
End DoDot:1
+33 QUIT
CKD ;Does patient have chronic kidney disease (CKD)?
+1 NEW APCHCKD,APCHLUPV,APCHLACV,APCHLEGV,APCHLACD,APCHLCRD,APCHLCRV,APCHLEGD
+2 SET APCHCKD=0
+3 ;get last serum creatinine value
+4 SET T=$ORDER(^ATXLAB("B","DM AUDIT CREATININE TAX",0))
IF $GET(T)]""
SET APCHLCRV=$$LAB^BHSPMH2(BHSDFN,T)
SET APCHLCRD=$PIECE($GET(APCHLCRV),"|||",2)
SET APCHLCRV=$PIECE($GET(APCHLCRV),"|||")
IF $GET(APCHLCRV)]""
Begin DoDot:1
+5 IF $$SEX^AUPNPAT(BHSDFN)="F"
IF APCHLCRV>1.3
SET APCHCKD=1
+6 IF $$SEX^AUPNPAT(BHSDFN)="M"
IF APCHLCRV>1.5
SET APCHCKD=1
End DoDot:1
+7 ;get last urine protein value
+8 IF APCHCKD=1
QUIT
SET T=$ORDER(^ATXLAB("B","DM AUDIT URINE PROTEIN TAX",0))
IF $GET(T)]""
SET APCHLUPV=$$LAB^BHSPMH2(BHSDFN,T)
SET APCHLUPD=$PIECE($GET(APCHLUPV),"|||",2)
SET APCHLUPV=$PIECE($GET(APCHLUPV),"|||")
IF $GET(APCHLUPV)]""
Begin DoDot:1
+9 IF +APCHLUPV>200
SET APCHCKD=1
End DoDot:1
+10 ;get last A/C ratio value
+11 IF APCHCKD=1
QUIT
SET T=$ORDER(^ATXLAB("B","DM AUDIT A/C RATIO TAX",0))
IF $GET(T)]""
SET APCHLACV=$$LAB^BHSPMH2(BHSDFN,T)
SET APCHLACD=$PIECE($GET(APCHLACV),"|||",2)
SET APCHLACV=$PIECE($GET(APCHLACV),"|||")
IF $GET(APCHLACV)]""
Begin DoDot:1
+12 IF +APCHLACV>200
SET APCHCKD=1
End DoDot:1
+13 ;get estimated GFR
+14 IF APCHCKD=1
QUIT
SET T=$ORDER(^ATXLAB("B","BGP GPRA ESTIMATED GFR TAX",0))
IF $GET(T)]""
SET APCHLEGV=$$LAB^BHSPMH2(BHSDFN,T)
SET APCHLEGD=$PIECE($GET(APCHLEGV),"|||",2)
SET APCHLEGV=$PIECE($GET(APCHLEGV),"|||")
IF $GET(APCHLEGV)]""
Begin DoDot:1
+15 IF APCHLEGV<60
SET APCHCKD=1
End DoDot:1
+16 QUIT
+17 ;
RXSTAT ; EP gets status of rx ... TAKEN FROM PSOFUNC ROUTINE
+1 ;USING V7
IF $DATA(^PSRX(APCHSRXP,"STA"))
QUIT
+2 IF $GET(APCHSRXP)'>0
QUIT
+3 SET J=APCHSRXP
+4 SET ST0=+$PIECE(RX0,"^",15)
IF ST0<12
IF $ORDER(^PS(52.5,"B",J,0))
IF $DATA(^PS(52.5,+$ORDER(^(0)),0))
IF '$GET(^("P"))
SET ST0=5
+5 IF ST0<12
IF $PIECE(RX2,"^",6)
IF $PIECE(RX2,"^",6)'>DT
SET ST0=11
+6 SET ST=$PIECE("ERROR^ACTIVE^NON-VERIFIED^REFILL FILL^HOLD^PENDING DUE TO DRUG INTERACTION^SUSPENDED^^^^^DONE^EXPIRED^CANCELLED^DELETED","^",ST0+2)
SET $PIECE(RX0,"^",15)=ST0
+7 QUIT
+8 ;
+9 ;
HOLD ;Now get meds in Pharmacy yet to be completed
+1 IF 'BHSDFN
QUIT
+2 NEW APCHNMED,APCHSDT
+3 SET APCHSDT=DT
+4 FOR
SET APCHSDT=$ORDER(^PS(55,BHSDFN,"P","A",APCHSDT))
IF APCHSDT'=+APCHSDT
QUIT
Begin DoDot:1
+5 SET APCHNMED=0
FOR
SET APCHNMED=$ORDER(^PS(55,BHSDFN,"P","A",APCHSDT,APCHNMED))
IF 'APCHNMED
QUIT
Begin DoDot:2
+6 IF $GET(^PSRX(APCHNMED,"STA"))=3!($GET(^PSRX(APCHNMED,"STA"))=5)
Begin DoDot:3
+7 SET APCHHMED=$PIECE(^PSRX(APCHNMED,0),U,6)
IF $GET(APCHHMED)]""
SET APCHHMED=$PIECE(^PSDRUG(APCHHMED,0),U)
+8 SET APCHHM(APCHHMED)=APCHNMED
End DoDot:3
+9 QUIT
End DoDot:2
End DoDot:1
+10 QUIT
+11 ;
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,L
+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("BHSPHS",$JOB,"PMH",0),U)+1
SET $PIECE(^TMP("BHSPHS",$JOB,"PMH",0),U)=%
+2 SET ^TMP("BHSPHS",$JOB,"PMH",%)=X
+3 QUIT
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)
GETHWBBP(P) ;get last height, height date, weight, weight date, BMI and BP for patient P, return in BHSX("HT"),BHSX("HTD"),BHSX("WT"),BHSX("WTD"),BHSX("BMI")
+1 KILL BHSX
+2 SET BHSX("HT")=""
SET BHSX("HTD")=""
SET BHSX("WT")=""
SET BHSX("WTD")=""
SET BHSX("BMI")=""
SET BHSX("WC")=""
SET BHSX("WCD")=""
LASTHT ;
+1 IF '$DATA(^AUPNVSIT("AC",P))
QUIT
+2 IF '$DATA(^AUPNVMSR("AC",P))
QUIT
+3 NEW BHSY
+4 SET %=P_"^LAST MEAS HT"
NEW X
SET E=$$START1^APCLDF(%,"BHSY(")
SET BHSX("HT")=$PIECE($GET(BHSY(1)),U,2)
SET BHSX("HTD")=$PIECE($GET(BHSY(1)),U)
+5 SET BHSX("HT")=$SELECT(BHSX("HT")]"":$JUSTIFY(BHSX("HT"),2,0),1:"")
LASTWT ;
+1 KILL BHSY
SET %=P_"^LAST MEAS WT"
NEW X
SET E=$$START1^APCLDF(%,"BHSY(")
SET BHSX("WT")=$PIECE($GET(BHSY(1)),U,2)
SET BHSX("WTD")=$PIECE($GET(BHSY(1)),U)
LASTBP ;
+1 KILL BHSY
SET %=P_"^LAST MEAS BP"
NEW X
SET E=$$START1^APCLDF(%,"BHSY(")
SET BHSX("BP")=$PIECE($GET(BHSY(1)),U,2)
SET BHSX("BPD")=$PIECE($GET(BHSY(1)),U)
LASTWC ;
+1 KILL BHSY
SET %=P_"^LAST MEAS WC"
NEW X
SET E=$$START1^APCLDF(%,"BHSY(")
SET BHSX("WC")=$PIECE($GET(BHSY(1)),U,2)
SET BHSX("WCD")=$PIECE($GET(BHSY(1)),U)
BMI ;
+1 IF $$AGE^AUPNPAT(P)<19
IF (BHSX("WTD")'=BHSX("HTD"))
QUIT
+2 IF BHSX("WT")=""!('BHSX("HT"))
QUIT
+3 SET %=""
+4 SET W=BHSX("WT")*.45359
SET H=(BHSX("HT")*0.0254)
SET H=(H*H)
SET %=(W/H)
SET %=$JUSTIFY(%,4,1)
+5 SET BHSX("BMI")=%
+6 QUIT
+7 ;
DMDX(P) ;
+1 ;check problem list OR must have 3 diagnoses
+2 NEW T
+3 SET T=$ORDER(^ATXAX("B","SURVEILLANCE DIABETES",0))
+4 IF 'T
QUIT ""
+5 NEW X,Y,I
SET (X,Y,I)=0
FOR
SET X=$ORDER(^AUPNPROB("AC",P,X))
IF X'=+X!(I)
QUIT
Begin DoDot:1
+6 IF $DATA(^AUPNPROB(X,0))
SET Y=$PIECE(^AUPNPROB(X,0),U)
IF $$ICD^ATXCHK(Y,T,9)
SET I=1
End DoDot:1
+7 IF I
QUIT "Yes"
+8 NEW BHSX
+9 SET BHSX=""
+10 SET X=P_"^LAST 3 DX [SURVEILLANCE DIABETES"
SET E=$$START1^APCLDF(X,"BHSX(")
IF E
GOTO DMX
IF $DATA(BHSX(3))
SET BHSX="Yes"
+11 IF $GET(BHSX)=""
SET BHSX="No"
DMX ;
+1 QUIT BHSX
+2 ;
