- 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 ;