APCHAAP2 ; IHS/CMI/LAB - ;
;;2.0;IHS PCC SUITE;**2**;MAY 14, 2009
;
PRINT ;EP
S APCHQ=0
W !,$P(^DIC(4,DUZ(2),0),U),?53,"Today's Date: ",$$FMTE^XLFDT(DT),!
W "Patient Name: ",$P(^DPT(DFN,0),U)
W ?45,"Birth Date: ",$$DOB^AUPNPAT(DFN,"E")
W ?71,"Age: ",$$AGE^AUPNPAT(DFN),!
W $$REPEAT^XLFSTR("_",79),!
W "My Doctor: " S X=$$DPCP^APCHPWH1(DFN) W:X $P(^VA(200,X,0),U) W " Phone number: ",$$VAL^XBDIQ1(9999999.06,DUZ(2),.13),!
W " Address: ",$$VAL^XBDIQ1(9999999.06,DUZ(2),.14)_" "_$$VAL^XBDIQ1(9999999.06,DUZ(2),.15)_$S($$VAL^XBDIQ1(9999999.06,DUZ(2),.15)]"":", ",1:" ")
W:$P(^AUTTLOC(DUZ(2),0),U,14) $P(^DIC(5,$$VALI^XBDIQ1(9999999.06,DUZ(2),.16),0),U,2) W " "_$$VAL^XBDIQ1(9999999.06,DUZ(2),.17),!
W "My Pharmacy: ",$$PHARM(DUZ(2),"N")," Phone number: ",$$PHARM(DUZ(2),"P"),!
W "My Contact person: ",$$EC(DFN,"N")," Phone number: ",$$EC(DFN,"P"),!
W $$REPEAT^XLFSTR("_",79),!!
W "Asthma Triggers",!
S APCHG=0 K APCHSX
S APCHC=$O(^AUTTHF("B","ASTHMA TRIGGERS",0))
G:'APCHC AAP
S APCHF=0 F S APCHF=$O(^AUTTHF("AC",APCHC,APCHF)) Q:APCHF'=+APCHF D
.Q:'$D(^AUPNVHF("AA",DFN,APCHF))
.S D=$O(^AUPNVHF("AA",DFN,APCHF,""))
.S X=" "_$P(^AUTTHF(APCHF,0),U),$E(X,40)="Documented on "_$$FMTE^XLFDT((9999999-D)) W ?5,X,! S APCHG=1
I 'APCHG W "No Triggers identified.",!
AAP ;
I $Y>(IOSL-5) D HEAD Q:APCHQ
W !,"ASTHMA ACTION PLAN",!!
S APCHB=$$PBPF^APCHSAST(DFN,"B")
I $P(APCHB,U,2)]"" D
.W "Do your peak flow today. What is your number? What Zone are you in?",!
.I $Y>(IOSL-3) D HEAD Q:APCHQ
.NEW R,Y,G
.S R=$$REDH($P(APCHB,U,2)) I R]"" S R="0-"_R
.W ?2,$$STRIP^XLFSTR(R," "),?11,"RED ZONE [0-49% of Best Peak Flow]",!
.S Y=$$YELLOW($P(APCHB,U,2),2)
.W ?2,$$STRIP^XLFSTR(Y," "),?11,"YELLOW ZONE [50-79% of Best Peak Flow]",!
.I $Y>(IOSL-3) D HEAD Q:APCHQ
.S G=$$GREEN($P(APCHB,U,2),2)
.W ?2,$$STRIP^XLFSTR(G," "),?11,"GREEN ZONE [80-100% of Best Peak Flow]",!!
I $Y>(IOSL-3) D HEAD Q:APCHQ
I $P(APCHB,U)="" W ?3,"Your Personal Best Peak Flow: None documented; please discuss with your",!,"provider at your next clinic visit.",!
I $P(APCHB,U)]"" W ?3,"Your Personal Best Peak Flow: ",$P(APCHB,U,2)," liters/minute on ",$$FMTE^XLFDT($P(APCHB,U,1)),!
I $Y>(IOSL-4) D HEAD Q:APCHQ
W !,"Follow these steps to control your asthma.",!
W $$REPEAT^XLFSTR("*",79),!
W !,"RED ZONE "_$S($P(APCHB,U)]"":"[49-0%]",1:"")_" - Need Medical Help!! ",!
I $Y>(IOSL-4) D HEAD Q:APCHQ
I $P(APCHB,U)]"" W "Peak Flow less than ",$$RED($P(APCHB,U,2),.50,2)," liters/minute",!," OR",!
W "You are coughing, short of breath, and wheezing.",!
W "You have trouble walking or talking.",!
I $Y>(IOSL-3) D HEAD Q:APCHQ
W "Your rescue medicine doesn't work.",!
I APCHRELM="" W !,"________________________________________________________________",!
I APCHRELM]"" D Q:APCHQ
.;attempt to wrap directions 70 characters
.K ^UTILITY($J,"W") S X=APCHRELM,DIWL=0,DIWR=70 D ^DIWP
.;S X=$S($L($G(^UTILITY($J,"W",0,1,0)))>1:$G(^UTILITY($J,"W",0,1,0)),$L($G(^UTILITY($J,"W",0,1,0)))=1:"No directions on file",1:" ") D S^APCHPWH1(X)
.F F=1:1:$G(^UTILITY($J,"W",0)) S X=$G(^UTILITY($J,"W",0,F,0)) Q:APCHQ D
..I $Y>(IOSL-3) D HEAD Q:APCHQ
..W !,X
.K ^UTILITY($J,"W")
.W !
I $Y>(IOSL-3) D HEAD Q:APCHQ
W !,"Ask someone to bring you to the Emergency Room, call 911, or call your doctor.",!
W $$REPEAT^XLFSTR("*",79),!
I $Y>(IOSL-4) D HEAD Q:APCHQ
W "YELLOW ZONE "_$S($P(APCHB,U)]"":"[50-79%]",1:""),"- Asthma is Getting Worse ",!
I $P(APCHB,U)]"" W "Peak Flow is ",$$YELLOW^APCHSAST($P(APCHB,U,2))," liters/minute",!," OR",!
W "You are coughing or wheezing.",!
I $Y>(IOSL-3) D HEAD Q:APCHQ
W "You are waking at night from your asthma.",!
W "You have some trouble doing usual activities.",!
I $Y>(IOSL-3) D HEAD Q:APCHQ
I APCHRESM="" W !,"________________________________________________________________",! I 1
I APCHRESM]"" D Q:APCHQ
.;attempt to wrap directions 70 characters
.K ^UTILITY($J,"W") S X=APCHRESM,DIWL=0,DIWR=70 D ^DIWP
.;S X=$S($L($G(^UTILITY($J,"W",0,1,0)))>1:$G(^UTILITY($J,"W",0,1,0)),$L($G(^UTILITY($J,"W",0,1,0)))=1:"No directions on file",1:" ") D S^APCHPWH1(X)
.F F=1:1:$G(^UTILITY($J,"W",0)) S X=$G(^UTILITY($J,"W",0,F,0)) Q:APCHQ D
..I $Y>(IOSL-3) D HEAD Q:APCHQ
..W !,X
.K ^UTILITY($J,"W")
.W !
W !,"Keep taking your green zone medications. Check your peak flow readings ",!,"every few hours.",!
I $Y>(IOSL-3) D HEAD Q:APCHQ
W !,"CALL YOUR DOCTOR or care provider IF:",!
W "1. You are in your yellow zone for more than 24-48 hours.",!
I $Y>(IOSL-3) D HEAD Q:APCHQ
W "2. OR You need to use your reliever medication more than every 4 hours.",!
W "3. OR Your symptoms are getting worse.",!
W $$REPEAT^XLFSTR("*",79),!
I $Y>(IOSL-3) D HEAD Q:APCHQ
W !,"GREEN ZONE "_$S($P(APCHB,U)]"":"[100-80%]",1:"")_" - You Are Doing Well ",!
I $P(APCHB,U)]"" W "Peak Flow is ",$$GREEN^APCHSAST($P(APCHB,U,2)),!," OR",!
I $Y>(IOSL-3) D HEAD Q:APCHQ
W "You have no coughing, wheezing, or chest tightness during the day or night.",!
W "You sleep through the night without coughing, wheezing, or chest tightness.",!
I $Y>(IOSL-3) D HEAD Q:APCHQ
W "You can do usual activities.",!
W !,"Take your long-term control medication every day.",!
MEDS ;
RELMEDS ;
K APCHL,APCHREL,APCHCONT
D LAST1YRR
D LAST1YRC
;
CONTMEDS ;
W !!,"Active Controller Medications",!
K APCHL
M APCHL=APCHCONT
D DISPMEDS
W !,"Active Reliever Medications",!
K APCHL
M APCHL=APCHREL
D DISPMEDS
Q
HEAD ;
I $E(IOST)="C",IO=IO(0) W ! S DIR(0)="EO" D ^DIR K DIR I Y=0!(Y="^")!($D(DTOUT)) S APCHQ=1 Q
HEAD1 ;
W:$D(IOF) @IOF
W !,$P(^DIC(4,DUZ(2),0),U),?53,"Today's Date: ",$$FMTE^XLFDT(DT),!
W "Patient Name: ",$P(^DPT(DFN,0),U)
W ?45,"Birth Date: ",$$DOB^AUPNPAT(DFN,"E")
W ?71,"Age: ",$$AGE^AUPNPAT(DFN),!
W $$REPEAT^XLFSTR("_",79),!!
Q
CTR(X,Y) ;EP - Center X in a field Y wide.
Q $J("",$S($D(Y):Y,1:IOM)-$L(X)\2)_X
;----------
EXIT ;
D EN^XBVK("APCH")
D ^XBFMK
Q
PHARM(L,I) ;
NEW %
S %=$O(^PS(59,"C",L,0))
I '%,I="N" Q $P(^DIC(4,L,0),U)
I '%,I="P" Q $$VAL^XBDIQ1(9999999.06,L,.13)
I I="N" Q $P(^PS(59,%,0),U)
I I="P" Q $P(^PS(59,%,0),U,4)
Q ""
;
EC(L,I) ;
NEW %
S F=$S(I="N":.331,1:.3319)
S %=$$VAL^XBDIQ1(2,L,F)
I %]"" Q %
S F=$S(I="N":.211,1:.219)
Q $$VAL^XBDIQ1(2,L,F)
;
GREEN(V,F) ;
NEW P,P1
I $G(V)="" Q ""
S P=(V*.80),P=$J(P,3,0),P1=V
I F=1 Q P_"-"_V_" liters/minute"
Q P_"-"_V
YELLOW(V,F) ;
NEW P,P1
I $G(V)="" Q ""
S P=(V*.50)
S P=$J(P,3,0)
S P1=(V*.80),P1=P1-1,P1=$J(P1,3,0)
I F=1 Q P_"-"_P1_" liters/minute"
I F=2 Q P_"-"_P1
RED(V,D,F) ;
NEW P,P1
I $G(V)="" Q ""
I $G(D)="" S D=.50
S P=(V*D)
S P=P+.5,P=$J(P,3,0)
I F=1 Q "<"_P_" liters/minute"
Q $TR(P," ")
;
REDH(V) ;
NEW P
S P=((.50*V)-1)
Q $TR($J(P,3,0)," ")
;
Q
;
DISPMEDS ;EP
I '$O(APCHL(0)) W !,"None documented; please discuss with your provider at your next",!,"clinic visit.",! Q
S D=0 F S D=$O(APCHL(D)) Q:D'=+D D
.S E=0 F S E=$O(APCHL(D,E)) Q:E'=+E S N=^AUPNVMED(E,0) D
..S APCHD=$$FMTE^XLFDT($P(^AUPNVSIT($P(N,U,3),0),U),"5D")
..S APCHDC=$P(N,U,8),APCHDYS=$P(N,U,7),APCHMFX=$S($P(N,U,4)="":+N,1:$P(N,U,4)) S:APCHDYS="" APCHDYS=30 S APCHRX=$S($D(^PSRX("APCC",E)):$O(^(E,0)),1:0)
..S APCHCRN=$S(+APCHRX:$D(^PS(55,DFN,"P","CP",APCHRX)),1:0)
..S APCHQTY=$P(N,U,6),APCHSIG=$P(N,U,5)
..S APCHDTM=$P($P(^AUPNVSIT($P(N,U,3),0),U),"."),APCHEXP=""
..S X=$$FMDIFF^XLFDT(DT,APCHDTM)
..I X>APCHDYS S Y=$$FMADD^XLFDT(APCHDTM,APCHDYS) S APCHEXP="-- Ran out "_$$FMTE^XLFDT(Y,"2D")
..S APCHMED=$S($P(N,U,4)="":$P(^PSDRUG(APCHMFX,0),U),1:$P(N,U,4))
..I APCHDC S Y=$$FMTE^XLFDT(APCHDC) S APCHEXP="-- D/C "_Y
..S APCHORTS=$G(^AUPNVMED(E,11))
..I APCHORTS["RETURNED TO STOCK",APCHDC S APCHEXP="--RTS "_Y
..D SIG S APCHSIG=APCHSSGY
..D REF I APCHREF S APCHSIG=APCHSIG_" "_APCHREF_$S(APCHREF=1:" refill",1:" refills")_" left."
..I $Y>(IOSL-4) D HEAD Q:APCHQ
..S X=APCHD,$E(X,13)=APCHMED_" #"_APCHQTY_" ("_APCHDYS_" days) "_APCHEXP W ?1,X,!
..S X="",$E(X,14)=$E(APCHSIG,1,65) W X,!
..I $L(APCHSIG)>65 S X="",$E(X,14)=$E(APCHSIG,66,999) W X,!
..Q
.Q
Q
;
SIG ;CONSTRUCT THE FULL TEXT FROM THE ENCODED SIG
S APCHSSGY="" F APCHSP=1:1:$L(APCHSIG," ") S X=$P(APCHSIG," ",APCHSP) I X]"" D
. S Y=$O(^PS(51,"B",X,0)) I Y>0 S X=$P(^PS(51,Y,0),"^",2) I $D(^(9)) S Y=$P(APCHSIG," ",APCHSP-1),Y=$E(Y,$L(Y)) S:Y>1 X=$P(^(9),"^",1)
. S APCHSSGY=APCHSSGY_X_" "
Q
;
REF ;DETERMINE THE NUMBER OF REFILLS REMAINING
I 'APCHRX S APCHREF=0 Q
S APCHRFL=$P(^PSRX(APCHRX,0),U,9) S APCHREF=0 F S APCHREF=$O(^PSRX(APCHRX,1,APCHREF)) Q:'APCHREF S APCHRFL=APCHRFL-1
S APCHREF=APCHRFL
Q
;
LAST1YRR ;EP
NEW T,E,D,Y,M,G,C,N
S APCHREL=0
S T(1)=$O(^ATXAX("B","BAT ASTHMA SHRT ACT RELV MEDS",0))
S T(2)=$O(^ATXAX("B","BAT ASTHMA SHRT ACT RELV NDC",0))
S T(3)=$O(^ATXAX("B","BAT ASTHMA SHRT ACT INHLR MEDS",0))
S T(4)=$O(^ATXAX("B","BAT ASTHMA SHRT ACT INHLR NDC",0))
S T(5)=$O(^ATXAX("B","BGP RA GLUCOCORTIOCOIDS MEDS",0))
S T(6)=$O(^ATXAX("B","BGP RA GLUCOCORTIOCOIDS CLASS",0))
S E=9999999-$$FMADD^XLFDT(DT,-183)
S D=0 F S D=$O(^AUPNVMED("AA",DFN,D)) Q:D'=+D!(D>E) D
.S M=0 F S M=$O(^AUPNVMED("AA",DFN,D,M)) Q:M'=+M D
..Q:'$D(^AUPNVMED(M,0))
..S Y=$P(^AUPNVMED(M,0),U)
..Q:'Y
..;is it active?
..I $P(^AUPNVMED(M,0),U,8)]"",$P(^AUPNVMED(M,0),U,8)'>DT Q
..S APCHRXN=$O(^PSRX("APCC",M,0))
..S G=1 I APCHRXN D
...S APCHSTAT=$P($G(^PSRX(APCHRXN,"STA")),U,1)
...I APCHSTAT'=0 S G=0
..I 'G Q
..I T(1),$D(^ATXAX(T(1),21,"B",Y)) D SR Q
..I T(3),$D(^ATXAX(T(3),21,"B",Y)) D SR Q
..I T(5),$D(^ATXAX(T(5),21,"B",Y)) D SR Q
..S N=$P($G(^PSDRUG(Y,2)),U,4)
..Q:N=""
..I N]"",T(2),$D(^ATXAX(T(2),21,"B",N)) D SR Q
..I N]"",T(4),$D(^ATXAX(T(4),21,"B",N)) D SR Q
..S C=$P(^PSDRUG(Y,0),U,2)
..I C,T(6),$D(^ATXAX(T(6),21,"B",C)) D SR Q
.Q
Q
SR ;
S APCHREL(D,M)="",APCHREL=APCHREL+1
Q
;
LAST1YRC ;EP
NEW T,E,D,Y,M,G,C,N
S APCHCONT=0
S T(1)=$O(^ATXAX("B","BAT ASTHMA CONTROLLER MEDS",0))
S T(2)=$O(^ATXAX("B","BAT ASTHMA CONTROLLER NDC",0))
S T(3)=$O(^ATXAX("B","BAT ASTHMA INHALED STEROIDS",0))
S T(4)=$O(^ATXAX("B","BAT ASTHMA INHLD STEROIDS NDC",0))
S T(5)=$O(^ATXAX("B","BAT ASTHMA LEUKOTRIENE MEDS",0))
S T(6)=$O(^ATXAX("B","BAT ASTHMA LEUKOTRIENE NDC",0))
S E=9999999-$$FMADD^XLFDT(DT,-183)
S D=0 F S D=$O(^AUPNVMED("AA",DFN,D)) Q:D'=+D!(D>E) D
.S M=0 F S M=$O(^AUPNVMED("AA",DFN,D,M)) Q:M'=+M D
..Q:'$D(^AUPNVMED(M,0))
..S Y=$P(^AUPNVMED(M,0),U)
..Q:'Y
..;is it active?
..I $P(^AUPNVMED(M,0),U,8)]"",$P(^AUPNVMED(M,0),U,8)'>DT Q
..S APCHRXN=$O(^PSRX("APCC",M,0))
..S G=1 I APCHRXN D
...S APCHSTAT=$P($G(^PSRX(APCHRXN,"STA")),U,1)
...I APCHSTAT'=0 S G=0
..I 'G Q
..I T(1),$D(^ATXAX(T(1),21,"B",Y)) D SC Q
..I T(3),$D(^ATXAX(T(3),21,"B",Y)) D SC Q
..I T(5),$D(^ATXAX(T(5),21,"B",Y)) D SC Q
..S N=$P($G(^PSDRUG(Y,2)),U,4)
..Q:N=""
..I T(2),$D(^ATXAX(T(2),21,"B",N)) D SC Q
..I T(4),$D(^ATXAX(T(4),21,"B",N)) D SC Q
..I T(6),$D(^ATXAX(T(6),21,"B",N)) D SC Q
.Q
Q
SC ;
S APCHCONT(D,M)="",APCHCONT=APCHCONT+1
Q
;
APCHAAP2 ; IHS/CMI/LAB - ;
+1 ;;2.0;IHS PCC SUITE;**2**;MAY 14, 2009
+2 ;
PRINT ;EP
+1 SET APCHQ=0
+2 WRITE !,$PIECE(^DIC(4,DUZ(2),0),U),?53,"Today's Date: ",$$FMTE^XLFDT(DT),!
+3 WRITE "Patient Name: ",$PIECE(^DPT(DFN,0),U)
+4 WRITE ?45,"Birth Date: ",$$DOB^AUPNPAT(DFN,"E")
+5 WRITE ?71,"Age: ",$$AGE^AUPNPAT(DFN),!
+6 WRITE $$REPEAT^XLFSTR("_",79),!
+7 WRITE "My Doctor: "
SET X=$$DPCP^APCHPWH1(DFN)
IF X
WRITE $PIECE(^VA(200,X,0),U)
WRITE " Phone number: ",$$VAL^XBDIQ1(9999999.06,DUZ(2),.13),!
+8 WRITE " Address: ",$$VAL^XBDIQ1(9999999.06,DUZ(2),.14)_" "_$$VAL^XBDIQ1(9999999.06,DUZ(2),.15)_$SELECT($$VAL^XBDIQ1(9999999.06,DUZ(2),.15)]"":", ",1:" ")
+9 IF $PIECE(^AUTTLOC(DUZ(2),0),U,14)
WRITE $PIECE(^DIC(5,$$VALI^XBDIQ1(9999999.06,DUZ(2),.16),0),U,2)
WRITE " "_$$VAL^XBDIQ1(9999999.06,DUZ(2),.17),!
+10 WRITE "My Pharmacy: ",$$PHARM(DUZ(2),"N")," Phone number: ",$$PHARM(DUZ(2),"P"),!
+11 WRITE "My Contact person: ",$$EC(DFN,"N")," Phone number: ",$$EC(DFN,"P"),!
+12 WRITE $$REPEAT^XLFSTR("_",79),!!
+13 WRITE "Asthma Triggers",!
+14 SET APCHG=0
KILL APCHSX
+15 SET APCHC=$ORDER(^AUTTHF("B","ASTHMA TRIGGERS",0))
+16 IF 'APCHC
GOTO AAP
+17 SET APCHF=0
FOR
SET APCHF=$ORDER(^AUTTHF("AC",APCHC,APCHF))
IF APCHF'=+APCHF
QUIT
Begin DoDot:1
+18 IF '$DATA(^AUPNVHF("AA",DFN,APCHF))
QUIT
+19 SET D=$ORDER(^AUPNVHF("AA",DFN,APCHF,""))
+20 SET X=" "_$PIECE(^AUTTHF(APCHF,0),U)
SET $EXTRACT(X,40)="Documented on "_$$FMTE^XLFDT((9999999-D))
WRITE ?5,X,!
SET APCHG=1
End DoDot:1
+21 IF 'APCHG
WRITE "No Triggers identified.",!
AAP ;
+1 IF $Y>(IOSL-5)
DO HEAD
IF APCHQ
QUIT
+2 WRITE !,"ASTHMA ACTION PLAN",!!
+3 SET APCHB=$$PBPF^APCHSAST(DFN,"B")
+4 IF $PIECE(APCHB,U,2)]""
Begin DoDot:1
+5 WRITE "Do your peak flow today. What is your number? What Zone are you in?",!
+6 IF $Y>(IOSL-3)
DO HEAD
IF APCHQ
QUIT
+7 NEW R,Y,G
+8 SET R=$$REDH($PIECE(APCHB,U,2))
IF R]""
SET R="0-"_R
+9 WRITE ?2,$$STRIP^XLFSTR(R," "),?11,"RED ZONE [0-49% of Best Peak Flow]",!
+10 SET Y=$$YELLOW($PIECE(APCHB,U,2),2)
+11 WRITE ?2,$$STRIP^XLFSTR(Y," "),?11,"YELLOW ZONE [50-79% of Best Peak Flow]",!
+12 IF $Y>(IOSL-3)
DO HEAD
IF APCHQ
QUIT
+13 SET G=$$GREEN($PIECE(APCHB,U,2),2)
+14 WRITE ?2,$$STRIP^XLFSTR(G," "),?11,"GREEN ZONE [80-100% of Best Peak Flow]",!!
End DoDot:1
+15 IF $Y>(IOSL-3)
DO HEAD
IF APCHQ
QUIT
+16 IF $PIECE(APCHB,U)=""
WRITE ?3,"Your Personal Best Peak Flow: None documented; please discuss with your",!,"provider at your next clinic visit.",!
+17 IF $PIECE(APCHB,U)]""
WRITE ?3,"Your Personal Best Peak Flow: ",$PIECE(APCHB,U,2)," liters/minute on ",$$FMTE^XLFDT($PIECE(APCHB,U,1)),!
+18 IF $Y>(IOSL-4)
DO HEAD
IF APCHQ
QUIT
+19 WRITE !,"Follow these steps to control your asthma.",!
+20 WRITE $$REPEAT^XLFSTR("*",79),!
+21 WRITE !,"RED ZONE "_$SELECT($PIECE(APCHB,U)]"":"[49-0%]",1:"")_" - Need Medical Help!! ",!
+22 IF $Y>(IOSL-4)
DO HEAD
IF APCHQ
QUIT
+23 IF $PIECE(APCHB,U)]""
WRITE "Peak Flow less than ",$$RED($PIECE(APCHB,U,2),.50,2)," liters/minute",!," OR",!
+24 WRITE "You are coughing, short of breath, and wheezing.",!
+25 WRITE "You have trouble walking or talking.",!
+26 IF $Y>(IOSL-3)
DO HEAD
IF APCHQ
QUIT
+27 WRITE "Your rescue medicine doesn't work.",!
+28 IF APCHRELM=""
WRITE !,"________________________________________________________________",!
+29 IF APCHRELM]""
Begin DoDot:1
+30 ;attempt to wrap directions 70 characters
+31 KILL ^UTILITY($JOB,"W")
SET X=APCHRELM
SET DIWL=0
SET DIWR=70
DO ^DIWP
+32 ;S X=$S($L($G(^UTILITY($J,"W",0,1,0)))>1:$G(^UTILITY($J,"W",0,1,0)),$L($G(^UTILITY($J,"W",0,1,0)))=1:"No directions on file",1:" ") D S^APCHPWH1(X)
+33 FOR F=1:1:$GET(^UTILITY($JOB,"W",0))
SET X=$GET(^UTILITY($JOB,"W",0,F,0))
IF APCHQ
QUIT
Begin DoDot:2
+34 IF $Y>(IOSL-3)
DO HEAD
IF APCHQ
QUIT
+35 WRITE !,X
End DoDot:2
+36 KILL ^UTILITY($JOB,"W")
+37 WRITE !
End DoDot:1
IF APCHQ
QUIT
+38 IF $Y>(IOSL-3)
DO HEAD
IF APCHQ
QUIT
+39 WRITE !,"Ask someone to bring you to the Emergency Room, call 911, or call your doctor.",!
+40 WRITE $$REPEAT^XLFSTR("*",79),!
+41 IF $Y>(IOSL-4)
DO HEAD
IF APCHQ
QUIT
+42 WRITE "YELLOW ZONE "_$SELECT($PIECE(APCHB,U)]"":"[50-79%]",1:""),"- Asthma is Getting Worse ",!
+43 IF $PIECE(APCHB,U)]""
WRITE "Peak Flow is ",$$YELLOW^APCHSAST($PIECE(APCHB,U,2))," liters/minute",!," OR",!
+44 WRITE "You are coughing or wheezing.",!
+45 IF $Y>(IOSL-3)
DO HEAD
IF APCHQ
QUIT
+46 WRITE "You are waking at night from your asthma.",!
+47 WRITE "You have some trouble doing usual activities.",!
+48 IF $Y>(IOSL-3)
DO HEAD
IF APCHQ
QUIT
+49 IF APCHRESM=""
WRITE !,"________________________________________________________________",!
IF 1
+50 IF APCHRESM]""
Begin DoDot:1
+51 ;attempt to wrap directions 70 characters
+52 KILL ^UTILITY($JOB,"W")
SET X=APCHRESM
SET DIWL=0
SET DIWR=70
DO ^DIWP
+53 ;S X=$S($L($G(^UTILITY($J,"W",0,1,0)))>1:$G(^UTILITY($J,"W",0,1,0)),$L($G(^UTILITY($J,"W",0,1,0)))=1:"No directions on file",1:" ") D S^APCHPWH1(X)
+54 FOR F=1:1:$GET(^UTILITY($JOB,"W",0))
SET X=$GET(^UTILITY($JOB,"W",0,F,0))
IF APCHQ
QUIT
Begin DoDot:2
+55 IF $Y>(IOSL-3)
DO HEAD
IF APCHQ
QUIT
+56 WRITE !,X
End DoDot:2
+57 KILL ^UTILITY($JOB,"W")
+58 WRITE !
End DoDot:1
IF APCHQ
QUIT
+59 WRITE !,"Keep taking your green zone medications. Check your peak flow readings ",!,"every few hours.",!
+60 IF $Y>(IOSL-3)
DO HEAD
IF APCHQ
QUIT
+61 WRITE !,"CALL YOUR DOCTOR or care provider IF:",!
+62 WRITE "1. You are in your yellow zone for more than 24-48 hours.",!
+63 IF $Y>(IOSL-3)
DO HEAD
IF APCHQ
QUIT
+64 WRITE "2. OR You need to use your reliever medication more than every 4 hours.",!
+65 WRITE "3. OR Your symptoms are getting worse.",!
+66 WRITE $$REPEAT^XLFSTR("*",79),!
+67 IF $Y>(IOSL-3)
DO HEAD
IF APCHQ
QUIT
+68 WRITE !,"GREEN ZONE "_$SELECT($PIECE(APCHB,U)]"":"[100-80%]",1:"")_" - You Are Doing Well ",!
+69 IF $PIECE(APCHB,U)]""
WRITE "Peak Flow is ",$$GREEN^APCHSAST($PIECE(APCHB,U,2)),!," OR",!
+70 IF $Y>(IOSL-3)
DO HEAD
IF APCHQ
QUIT
+71 WRITE "You have no coughing, wheezing, or chest tightness during the day or night.",!
+72 WRITE "You sleep through the night without coughing, wheezing, or chest tightness.",!
+73 IF $Y>(IOSL-3)
DO HEAD
IF APCHQ
QUIT
+74 WRITE "You can do usual activities.",!
+75 WRITE !,"Take your long-term control medication every day.",!
MEDS ;
RELMEDS ;
+1 KILL APCHL,APCHREL,APCHCONT
+2 DO LAST1YRR
+3 DO LAST1YRC
+4 ;
CONTMEDS ;
+1 WRITE !!,"Active Controller Medications",!
+2 KILL APCHL
+3 MERGE APCHL=APCHCONT
+4 DO DISPMEDS
+5 WRITE !,"Active Reliever Medications",!
+6 KILL APCHL
+7 MERGE APCHL=APCHREL
+8 DO DISPMEDS
+9 QUIT
HEAD ;
+1 IF $EXTRACT(IOST)="C"
IF IO=IO(0)
WRITE !
SET DIR(0)="EO"
DO ^DIR
KILL DIR
IF Y=0!(Y="^")!($DATA(DTOUT))
SET APCHQ=1
QUIT
HEAD1 ;
+1 IF $DATA(IOF)
WRITE @IOF
+2 WRITE !,$PIECE(^DIC(4,DUZ(2),0),U),?53,"Today's Date: ",$$FMTE^XLFDT(DT),!
+3 WRITE "Patient Name: ",$PIECE(^DPT(DFN,0),U)
+4 WRITE ?45,"Birth Date: ",$$DOB^AUPNPAT(DFN,"E")
+5 WRITE ?71,"Age: ",$$AGE^AUPNPAT(DFN),!
+6 WRITE $$REPEAT^XLFSTR("_",79),!!
+7 QUIT
CTR(X,Y) ;EP - Center X in a field Y wide.
+1 QUIT $JUSTIFY("",$SELECT($DATA(Y):Y,1:IOM)-$LENGTH(X)\2)_X
+2 ;----------
EXIT ;
+1 DO EN^XBVK("APCH")
+2 DO ^XBFMK
+3 QUIT
PHARM(L,I) ;
+1 NEW %
+2 SET %=$ORDER(^PS(59,"C",L,0))
+3 IF '%
IF I="N"
QUIT $PIECE(^DIC(4,L,0),U)
+4 IF '%
IF I="P"
QUIT $$VAL^XBDIQ1(9999999.06,L,.13)
+5 IF I="N"
QUIT $PIECE(^PS(59,%,0),U)
+6 IF I="P"
QUIT $PIECE(^PS(59,%,0),U,4)
+7 QUIT ""
+8 ;
EC(L,I) ;
+1 NEW %
+2 SET F=$SELECT(I="N":.331,1:.3319)
+3 SET %=$$VAL^XBDIQ1(2,L,F)
+4 IF %]""
QUIT %
+5 SET F=$SELECT(I="N":.211,1:.219)
+6 QUIT $$VAL^XBDIQ1(2,L,F)
+7 ;
GREEN(V,F) ;
+1 NEW P,P1
+2 IF $GET(V)=""
QUIT ""
+3 SET P=(V*.80)
SET P=$JUSTIFY(P,3,0)
SET P1=V
+4 IF F=1
QUIT P_"-"_V_" liters/minute"
+5 QUIT P_"-"_V
YELLOW(V,F) ;
+1 NEW P,P1
+2 IF $GET(V)=""
QUIT ""
+3 SET P=(V*.50)
+4 SET P=$JUSTIFY(P,3,0)
+5 SET P1=(V*.80)
SET P1=P1-1
SET P1=$JUSTIFY(P1,3,0)
+6 IF F=1
QUIT P_"-"_P1_" liters/minute"
+7 IF F=2
QUIT P_"-"_P1
RED(V,D,F) ;
+1 NEW P,P1
+2 IF $GET(V)=""
QUIT ""
+3 IF $GET(D)=""
SET D=.50
+4 SET P=(V*D)
+5 SET P=P+.5
SET P=$JUSTIFY(P,3,0)
+6 IF F=1
QUIT "<"_P_" liters/minute"
+7 QUIT $TRANSLATE(P," ")
+8 ;
REDH(V) ;
+1 NEW P
+2 SET P=((.50*V)-1)
+3 QUIT $TRANSLATE($JUSTIFY(P,3,0)," ")
+4 ;
+5 QUIT
+6 ;
DISPMEDS ;EP
+1 IF '$ORDER(APCHL(0))
WRITE !,"None documented; please discuss with your provider at your next",!,"clinic visit.",!
QUIT
+2 SET D=0
FOR
SET D=$ORDER(APCHL(D))
IF D'=+D
QUIT
Begin DoDot:1
+3 SET E=0
FOR
SET E=$ORDER(APCHL(D,E))
IF E'=+E
QUIT
SET N=^AUPNVMED(E,0)
Begin DoDot:2
+4 SET APCHD=$$FMTE^XLFDT($PIECE(^AUPNVSIT($PIECE(N,U,3),0),U),"5D")
+5 SET APCHDC=$PIECE(N,U,8)
SET APCHDYS=$PIECE(N,U,7)
SET APCHMFX=$SELECT($PIECE(N,U,4)="":+N,1:$PIECE(N,U,4))
IF APCHDYS=""
SET APCHDYS=30
SET APCHRX=$SELECT($DATA(^PSRX("APCC",E)):$ORDER(^(E,0)),1:0)
+6 SET APCHCRN=$SELECT(+APCHRX:$DATA(^PS(55,DFN,"P","CP",APCHRX)),1:0)
+7 SET APCHQTY=$PIECE(N,U,6)
SET APCHSIG=$PIECE(N,U,5)
+8 SET APCHDTM=$PIECE($PIECE(^AUPNVSIT($PIECE(N,U,3),0),U),".")
SET APCHEXP=""
+9 SET X=$$FMDIFF^XLFDT(DT,APCHDTM)
+10 IF X>APCHDYS
SET Y=$$FMADD^XLFDT(APCHDTM,APCHDYS)
SET APCHEXP="-- Ran out "_$$FMTE^XLFDT(Y,"2D")
+11 SET APCHMED=$SELECT($PIECE(N,U,4)="":$PIECE(^PSDRUG(APCHMFX,0),U),1:$PIECE(N,U,4))
+12 IF APCHDC
SET Y=$$FMTE^XLFDT(APCHDC)
SET APCHEXP="-- D/C "_Y
+13 SET APCHORTS=$GET(^AUPNVMED(E,11))
+14 IF APCHORTS["RETURNED TO STOCK"
IF APCHDC
SET APCHEXP="--RTS "_Y
+15 DO SIG
SET APCHSIG=APCHSSGY
+16 DO REF
IF APCHREF
SET APCHSIG=APCHSIG_" "_APCHREF_$SELECT(APCHREF=1:" refill",1:" refills")_" left."
+17 IF $Y>(IOSL-4)
DO HEAD
IF APCHQ
QUIT
+18 SET X=APCHD
SET $EXTRACT(X,13)=APCHMED_" #"_APCHQTY_" ("_APCHDYS_" days) "_APCHEXP
WRITE ?1,X,!
+19 SET X=""
SET $EXTRACT(X,14)=$EXTRACT(APCHSIG,1,65)
WRITE X,!
+20 IF $LENGTH(APCHSIG)>65
SET X=""
SET $EXTRACT(X,14)=$EXTRACT(APCHSIG,66,999)
WRITE X,!
+21 QUIT
End DoDot:2
+22 QUIT
End DoDot:1
+23 QUIT
+24 ;
SIG ;CONSTRUCT THE FULL TEXT FROM THE ENCODED SIG
+1 SET APCHSSGY=""
FOR APCHSP=1:1:$LENGTH(APCHSIG," ")
SET X=$PIECE(APCHSIG," ",APCHSP)
IF X]""
Begin DoDot:1
+2 SET Y=$ORDER(^PS(51,"B",X,0))
IF Y>0
SET X=$PIECE(^PS(51,Y,0),"^",2)
IF $DATA(^(9))
SET Y=$PIECE(APCHSIG," ",APCHSP-1)
SET Y=$EXTRACT(Y,$LENGTH(Y))
IF Y>1
SET X=$PIECE(^(9),"^",1)
+3 SET APCHSSGY=APCHSSGY_X_" "
End DoDot:1
+4 QUIT
+5 ;
REF ;DETERMINE THE NUMBER OF REFILLS REMAINING
+1 IF 'APCHRX
SET APCHREF=0
QUIT
+2 SET APCHRFL=$PIECE(^PSRX(APCHRX,0),U,9)
SET APCHREF=0
FOR
SET APCHREF=$ORDER(^PSRX(APCHRX,1,APCHREF))
IF 'APCHREF
QUIT
SET APCHRFL=APCHRFL-1
+3 SET APCHREF=APCHRFL
+4 QUIT
+5 ;
LAST1YRR ;EP
+1 NEW T,E,D,Y,M,G,C,N
+2 SET APCHREL=0
+3 SET T(1)=$ORDER(^ATXAX("B","BAT ASTHMA SHRT ACT RELV MEDS",0))
+4 SET T(2)=$ORDER(^ATXAX("B","BAT ASTHMA SHRT ACT RELV NDC",0))
+5 SET T(3)=$ORDER(^ATXAX("B","BAT ASTHMA SHRT ACT INHLR MEDS",0))
+6 SET T(4)=$ORDER(^ATXAX("B","BAT ASTHMA SHRT ACT INHLR NDC",0))
+7 SET T(5)=$ORDER(^ATXAX("B","BGP RA GLUCOCORTIOCOIDS MEDS",0))
+8 SET T(6)=$ORDER(^ATXAX("B","BGP RA GLUCOCORTIOCOIDS CLASS",0))
+9 SET E=9999999-$$FMADD^XLFDT(DT,-183)
+10 SET D=0
FOR
SET D=$ORDER(^AUPNVMED("AA",DFN,D))
IF D'=+D!(D>E)
QUIT
Begin DoDot:1
+11 SET M=0
FOR
SET M=$ORDER(^AUPNVMED("AA",DFN,D,M))
IF M'=+M
QUIT
Begin DoDot:2
+12 IF '$DATA(^AUPNVMED(M,0))
QUIT
+13 SET Y=$PIECE(^AUPNVMED(M,0),U)
+14 IF 'Y
QUIT
+15 ;is it active?
+16 IF $PIECE(^AUPNVMED(M,0),U,8)]""
IF $PIECE(^AUPNVMED(M,0),U,8)'>DT
QUIT
+17 SET APCHRXN=$ORDER(^PSRX("APCC",M,0))
+18 SET G=1
IF APCHRXN
Begin DoDot:3
+19 SET APCHSTAT=$PIECE($GET(^PSRX(APCHRXN,"STA")),U,1)
+20 IF APCHSTAT'=0
SET G=0
End DoDot:3
+21 IF 'G
QUIT
+22 IF T(1)
IF $DATA(^ATXAX(T(1),21,"B",Y))
DO SR
QUIT
+23 IF T(3)
IF $DATA(^ATXAX(T(3),21,"B",Y))
DO SR
QUIT
+24 IF T(5)
IF $DATA(^ATXAX(T(5),21,"B",Y))
DO SR
QUIT
+25 SET N=$PIECE($GET(^PSDRUG(Y,2)),U,4)
+26 IF N=""
QUIT
+27 IF N]""
IF T(2)
IF $DATA(^ATXAX(T(2),21,"B",N))
DO SR
QUIT
+28 IF N]""
IF T(4)
IF $DATA(^ATXAX(T(4),21,"B",N))
DO SR
QUIT
+29 SET C=$PIECE(^PSDRUG(Y,0),U,2)
+30 IF C
IF T(6)
IF $DATA(^ATXAX(T(6),21,"B",C))
DO SR
QUIT
End DoDot:2
+31 QUIT
End DoDot:1
+32 QUIT
SR ;
+1 SET APCHREL(D,M)=""
SET APCHREL=APCHREL+1
+2 QUIT
+3 ;
LAST1YRC ;EP
+1 NEW T,E,D,Y,M,G,C,N
+2 SET APCHCONT=0
+3 SET T(1)=$ORDER(^ATXAX("B","BAT ASTHMA CONTROLLER MEDS",0))
+4 SET T(2)=$ORDER(^ATXAX("B","BAT ASTHMA CONTROLLER NDC",0))
+5 SET T(3)=$ORDER(^ATXAX("B","BAT ASTHMA INHALED STEROIDS",0))
+6 SET T(4)=$ORDER(^ATXAX("B","BAT ASTHMA INHLD STEROIDS NDC",0))
+7 SET T(5)=$ORDER(^ATXAX("B","BAT ASTHMA LEUKOTRIENE MEDS",0))
+8 SET T(6)=$ORDER(^ATXAX("B","BAT ASTHMA LEUKOTRIENE NDC",0))
+9 SET E=9999999-$$FMADD^XLFDT(DT,-183)
+10 SET D=0
FOR
SET D=$ORDER(^AUPNVMED("AA",DFN,D))
IF D'=+D!(D>E)
QUIT
Begin DoDot:1
+11 SET M=0
FOR
SET M=$ORDER(^AUPNVMED("AA",DFN,D,M))
IF M'=+M
QUIT
Begin DoDot:2
+12 IF '$DATA(^AUPNVMED(M,0))
QUIT
+13 SET Y=$PIECE(^AUPNVMED(M,0),U)
+14 IF 'Y
QUIT
+15 ;is it active?
+16 IF $PIECE(^AUPNVMED(M,0),U,8)]""
IF $PIECE(^AUPNVMED(M,0),U,8)'>DT
QUIT
+17 SET APCHRXN=$ORDER(^PSRX("APCC",M,0))
+18 SET G=1
IF APCHRXN
Begin DoDot:3
+19 SET APCHSTAT=$PIECE($GET(^PSRX(APCHRXN,"STA")),U,1)
+20 IF APCHSTAT'=0
SET G=0
End DoDot:3
+21 IF 'G
QUIT
+22 IF T(1)
IF $DATA(^ATXAX(T(1),21,"B",Y))
DO SC
QUIT
+23 IF T(3)
IF $DATA(^ATXAX(T(3),21,"B",Y))
DO SC
QUIT
+24 IF T(5)
IF $DATA(^ATXAX(T(5),21,"B",Y))
DO SC
QUIT
+25 SET N=$PIECE($GET(^PSDRUG(Y,2)),U,4)
+26 IF N=""
QUIT
+27 IF T(2)
IF $DATA(^ATXAX(T(2),21,"B",N))
DO SC
QUIT
+28 IF T(4)
IF $DATA(^ATXAX(T(4),21,"B",N))
DO SC
QUIT
+29 IF T(6)
IF $DATA(^ATXAX(T(6),21,"B",N))
DO SC
QUIT
End DoDot:2
+30 QUIT
End DoDot:1
+31 QUIT
SC ;
+1 SET APCHCONT(D,M)=""
SET APCHCONT=APCHCONT+1
+2 QUIT
+3 ;
