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

APCHAAP2.m

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