BATVSUM ; IHS/CMI/LAB - ;
;;1.0;IHS ASTHMA REGISTER;;FEB 19, 2003
;
EN ;
W:$D(IOF) @IOF
W !!,$$CTR^BATU("*** List Asthma Patient's Asthma Visit History ***"),!!
W "This report will print the Asthma Visit History and Asthma Medication History",!,"for a patient on the Asthma Register.",!
S DIC="^BATREG(",DIC(0)="AEMQ" D ^DIC
I Y=-1 D EXIT Q
S DFN=+Y
W !
ZIS ;
W ! S DIR(0)="S^P:PRINT Output;B:BROWSE Output on Screen",DIR("A")="Do you wish to",DIR("B")="P" K DA D ^DIR K DIR
I $D(DIRUT) D EXIT Q
S BATOPT=Y
I Y="B" D BROWSE,EXIT Q
S XBRP="PRINT^BATVSUM",XBRC="",XBRX="EXIT^BATVSUM",XBNS="BAT;DFN"
D ^XBDBQUE
D EXIT
Q
BROWSE ;
S XBRP="VIEWR^XBLM(""PRINT^BATVSUM"")"
S XBRC="",XBRX="EXIT^BATVSUM",XBIOP=0 D ^XBDBQUE
Q
EXIT ;
D EN^XBVK("BAT")
D ^XBFMK
Q
S(Y,F,C,T) ;set up array
I '$G(F) S F=0
I '$G(T) S T=0
NEW %,X
;blank lines
F F=1:1:F S X="" D S1
S X=Y
I $G(C) S L=$L(Y),T=(80-L)/2 D D S1 Q
.F %=1:1:(T-1) S X=" "_X
F %=1:1:T S X=" "_Y
D S1
Q
S1 ;
S %=$P(^TMP("BATAST",$J,"DCS",0),U)+1,$P(^TMP("BATAST",$J,"DCS",0),U)=%
S ^TMP("BATAST",$J,"DCS",%)=X
Q
PRINT ;
D EP(DFN) ;gather up data
K ^TMP("BATAST",$J)
Q
EP(DFN) ;asthma register summary
D EP2(DFN)
W ;write out array
W:$D(IOF) @IOF
K BATQUIT
S BATX=0 F S BATX=$O(^TMP("BATAST",$J,"DCS",BATX)) Q:BATX'=+BATX!($D(BATQUIT)) D
.I $Y>(IOSL-3) D HEADER Q:$D(BATQUIT)
.W !,^TMP("BATAST",$J,"DCS",BATX)
.Q
I $D(BATQUIT) S BATSQIT=1
D EOJ
Q
;
EOJ ;
K BATX,BATQUIT,BATY,BATSDFN,BATSBEG,BATSTOB,BATSUPI,BATSED,BATTOBN,BATTOB
K N,%,T,F,X,Y,B,C,E,F,H,L,N,P,T,W
Q
I $E(IOST)="C",IO=IO(0) W ! S DIR(0)="EO" D ^DIR K DIR I Y=0!(Y="^")!($D(DTOUT)) S BATQUIT="" Q
HEAD1 ;
W:$D(IOF) @IOF
Q
EP2(BATSDFN) ;EP - PASS DFN get back array of patient care summary
;at this point you are stuck with ^TMP("BATAST",$J,"DCS"
K ^TMP("BATAST",$J,"DCS")
S ^TMP("BATAST",$J,"DCS",0)=0
D SETARRAY
Q
SETARRAY ;set up array containing dm care summary
S X="****** CONFIDENTIAL PATIENT INFORMATION -- "_$$HTE^XLFDT($H)_" ["_$P(^VA(200,DUZ,0),U,2)_" ] ******" D S(X)
S X="ASTHMA PATIENT CARE SUMMARY Report Date: "_$$FMTE^XLFDT(DT) D S(X,1)
S X=$P(^DPT(DFN,0),U),$E(X,35)="HRN: "_$$HRN^AUPNPAT(DFN,DUZ(2)) D S(X,1)
S X="DOB: "_$$DOB^AUPNPAT(DFN,"E")_" Age: "_$$AGE^AUPNPAT(DFN)_" "_$$SEX^AUPNPAT(DFN) S Y=$$VAL^XBDIQ1(90181.01,DFN,.02) S $E(X,35)="Asthma Register Status: "_$S(Y]"":Y,1:"NOT ON REGISTER") D S(X)
S X="Problem List: "
S Y=$$PLAST^BATU(DFN,2) ;get problem list # and narrative
I Y="" S Y="ASTHMA IS NOT ON THIS PATIENT'S PROBLEM LIST"
S X=X_Y D S(X)
S X="Primary Care Provider: "_$$VAL^XBDIQ1(9000001,DFN,.14) D S(X)
S X="Last Asthma Visit: "_$$LASTAV^BATU(DFN,3),$E(X,35)="Calculated Next Due: "_$$FMTE^XLFDT($$NEXT^BATU(DFN)) D S(X)
S BATPBF=$$LASTPBF^BATU(DFN)
I BATPBF]"" S X="Personal Best Peak Flow "_BATPBF_" liters/minute on "_$$LASTPBF^BATU(DFN,2) D S(X,1)
I BATPBF="" S X="Personal Best Peak Flow NOT documented. NEEDS TO BE REVIEWED" D S(X,1)
S X="Peak Flow Zones",$E(X,20)="Green (80-100%)",$E(X,39)=$$GREEN(BATPBF) D S(X,1)
S X="",$E(X,20)="Yellow (50-79%)",$E(X,39)=$$YELLOW(BATPBF) D S(X)
S X="",$E(X,20)="Red (< 50%)",$E(X,39)=$$RED(BATPBF) D S(X)
S Y=$$LASTSEV^BATU(DFN,5)
I Y="" S X="Severity NOT DOCUMENTED, NEEDS TO BE REVIEWED" D S(X,1)
I Y]"" S X="Severity "_Y_" documented on "_$$LASTSEV^BATU(DFN,3) D S(X,1)
S Y=$$LASTAM^BATU(DFN,2) I Y]"" S X="Date of Last Asthma Management Plan: "_Y D S(X,1)
I Y="" S X="Date of Last Asthma Managment Plan: NEEDS TO BE REVIEWED" D S(X,1)
S X="Triggers (Last Documented Value)" D S(X,1)
S X="",Y=$$LASTETS^BATU(DFN,1),$E(X,8)="ETS",$E(X,28)=$S(Y]"":Y,1:"NOT DOCUMENTED, NEEDS TO BE REVIEWED"),$E(X,35)=$S(Y]"":$$LASTETS^BATU(DFN,2),1:"") D S(X)
S X="",Y=$$LASTPARM^BATU(DFN,1),$E(X,8)="PARTICULATE MATTER",$E(X,28)=$S(Y]"":Y,1:"NOT DOCUMENTED, NEEDS TO BE REVIEWED"),$E(X,35)=$S(Y]"":$$LASTPARM^BATU(DFN,2),1:"") D S(X)
S X="",Y=$$LASTDM^BATU(DFN,1),$E(X,8)="DUST MITE",$E(X,28)=$S(Y]"":Y,1:"NOT DOCUMENTED, NEEDS TO BE REVIEWED"),$E(X,35)=$S(Y]"":$$LASTDM^BATU(DFN,2),1:"") D S(X)
S Y=$$LASTHF^BATSUM(DFN,"TOBACCO"),X="Last Recorded TOBACCO Health Factor: "_$P(Y,U,2)_" "_$$FMTE^XLFDT($P(Y,U)) D S(X,1)
D LAST5
S X="Last 5 Asthma Visits - LUNG FUNCTION" D S(X,1)
S X="",$E(X,3)="DATE",$E(X,20)="FEV 1",$E(X,38)="FEF 25-75",$E(X,56)="PEF/Best PF" D S(X)
S X="",$P(X,"-",75)="" D S(X)
I '$D(BATL) S X="NO ASTHMA VISITS ON FILE" D S(X) G N
S Y=0 F S Y=$O(BATL(Y)) Q:Y'=+Y S E=BATL(Y) D
.S X="",$E(X,3)=$$FMTE^XLFDT($P($P(^AUPNVSIT($P(^AUPNVAST(E,0),U,3),0),U),"."),"1D"),$E(X,20)=$P(^AUPNVAST(E,0),U,5)_" % predicted"
.S $E(X,38)=$P(^AUPNVAST(E,0),U,6)_" % predicted",$E(X,56)=$P(^AUPNVAST(E,0),U,7)_" liters/minute" D S(X)
N ;more stuff
S Y=$$NREL^BATU(DFN,$$FMTE^XLFDT($$FMADD^XLFDT(DT,-365)),$$FMTE^XLFDT(DT))
S X="Number of Reliever Fills in past 12 months: "_Y D S(X,1)
;last 5 medication prescriptions filled
S T=$O(^ATXAX("B","BAT ASTHMA RELIEVER MEDS",0))
I 'T S X="BAT ASTHMA RELIEVER MEDS taxonomy missing - cannot display meds" D S(X,1) G COMN
S T=$O(^ATXAX("B","BAT ASTHMA CONTROLLER MEDS",0))
I 'T S X="BAT ASTHMA CONTROLLER MEDS taxonomy missing - cannot display meds" D S(X,1) G COMN
S T=$O(^ATXAX("B","BAT ASTHMA INHALED STEROIDS",0))
I 'T S X="BAT ASTHMA INHALED STEROIDS MEDS taxonomy missing - cannot display meds" D S(X,1) G COMN
D LAST1YRM
I '$D(BATL) S X="<< No Asthma Medications found. >>" D S(X,1) G COMN
S X="",$E(X,3)="-----------ASTHMA MEDICATIONS (PRESCRIPTIONS FILLED IN PAST YEAR)----------" D S(X,1)
S D=0 F S D=$O(BATL(D)) Q:D'=+D D
.S E=0 F S E=$O(BATL(D,E)) Q:E'=+E S N=^AUPNVMED(E,0) D
..S BATD=$$FMTE^XLFDT($P(^AUPNVSIT($P(N,U,3),0),U),"2D")
..S BATDC=$P(N,U,8),BATDYS=$P(N,U,7),BATMFX=$S($P(N,U,4)="":+N,1:$P(N,U,4)) S:BATDYS="" BATDYS=30 S BATRX=$S($D(^PSRX("APCC",E)):$O(^(E,0)),1:0)
..S BATCRN=$S(+BATRX:$D(^PS(55,DFN,"P","CP",BATRX)),1:0)
..S BATQTY=$P(N,U,6),BATSIG=$P(N,U,5)
..S BATDTM=$P($P(^AUPNVSIT($P(N,U,3),0),U),"."),BATEXP=""
..S X=$$FMDIFF^XLFDT(DT,BATDTM)
..I X>BATDYS S Y=$$FMADD^XLFDT(BATDTM,BATDYS) S BATEXP="-- Ran out "_$$FMTE^XLFDT(Y,"2D")
..S BATMED=$S($P(N,U,4)="":$P(^PSDRUG(BATMFX,0),U),1:$P(N,U,4))
..I BATDC S Y=$$FMTE^XLFDT(BATDC,"2D") S BATEXP="-- D/C "_Y
..S BATORTS=$G(^AUPNVMED(E,11))
..I BATORTS["RETURNED TO STOCK",BATDC S BATEXP="--RTS "_Y
..D SIG S BATSIG=BATSSGY
..D REF I BATREF S BATSIG=BATSIG_" "_BATREF_$S(BATREF=1:" refill",1:" refills")_" left."
..S X=BATD,$E(X,9)=$S(BATCRN:"(C)",1:""),$E(X,13)=BATMED_" #"_BATQTY_" ("_BATDYS_" days) "_BATEXP D S(X)
..S X="",$E(X,14)=$E(BATSIG,1,65) D S(X)
..I $L(BATSIG)>65 S X="",$E(X,14)=$E(BATSIG,66,999) D S(X)
..Q
.Q
E ;
K BATEDUC D EDUC^BATSUM(DFN,.BATEDUC)
I $D(BATEDUC) D
.S X="Last of each ASTHMA Patient Education done:" D S(X,1)
.S N="" F S N=$O(BATEDUC(N)) Q:N="" S X=" "_N,$E(X,50)=$$FMTE^XLFDT(BATEDUC(N)) D S(X)
COMN ;if comments/notes in register print them
I $O(^BATREG(DFN,11,0)) D
.S X="",$E(X,3)="Comments/Notes from Register:" D S(X,1)
.K BATAR D ENP^XBDIQ1(90181.01,DFN,1100,"BATAR(","E")
.S F=0 F S F=$O(BATAR(1100,F)) Q:F'=+F S X="",$E(X,5)=BATAR(1100,F) D S(X)
N1 ;
S X="" D S(X,1)
Q
SIG ;CONSTRUCT THE FULL TEXT FROM THE ENCODED SIG
S BATSSGY="" F BATSP=1:1:$L(BATSIG," ") S X=$P(BATSIG," ",BATSP) 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(BATSIG," ",BATSP-1),Y=$E(Y,$L(Y)) S:Y>1 X=$P(^(9),"^",1)
. S BATSSGY=BATSSGY_X_" "
Q
;
REF ;DETERMINE THE NUMBER OF REFILLS REMAINING
I 'BATRX S BATREF=0 Q
S BATRFL=$P(^PSRX(BATRX,0),U,9) S BATREF=0 F S BATREF=$O(^PSRX(BATRX,1,BATREF)) Q:'BATREF S BATRFL=BATRFL-1
S BATREF=BATRFL
Q
GREEN(V) ;
NEW P,P1
S P=$J((V*.80),3,0),P1=V
Q P_"-"_V_" liters/minute"
YELLOW(V) ;
NEW P,P1
S P=$J((V*.50),3,0),P1=$J((V*.79),3,0)
Q P_"-"_P1_" liters/minute"
RED(V) ;
NEW P,P1
S P=$J((V*.50),3,0)
Q "< "_P_" liters/minute"
;
LAST1YRM ;
NEW T,T1,T2,E,D,Y,M
S T=$O(^ATXAX("B","BAT ASTHMA RELIEVER MEDS",0))
S T1=$O(^ATXAX("B","BAT ASTHMA INHALED STEROIDS",0))
S T2=$O(^ATXAX("B","BAT ASTHMA CONTROLLER MEDS",0))
K BATL
S E=9999999-$$FMADD^XLFDT(DT,-365)
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 S Y=$P(^AUPNVMED(M,0),U) I $D(^ATXAX(T,21,"B",Y))!($D(^ATXAX(T1,21,"B",Y)))!($D(^ATXAX(T2,21,"B",Y))) S BATL(D,M)=""
.Q
Q
LAST5 ;
;get last 2 years worth
NEW EDATE
S EDATE=$$FMADD^XLFDT(DT,-(365*2))
S EDATE=9999999-EDATE
K BATL
NEW D,E,C S (D,C)=0 F S D=$O(^AUPNVAST("AA",DFN,D)) Q:D'=+D!(D>EDATE) D
.K BATL1 S E=0 F S E=$O(^AUPNVAST("AA",DFN,D,E)) Q:E'=+E D
..S BATL1(9999999-E)=E
.S E=0 F S E=$O(BATL1(E)) Q:E'=+E S BATL(E)=BATL1(E),C=C+1
.Q
Q
BATVSUM ; IHS/CMI/LAB - ;
+1 ;;1.0;IHS ASTHMA REGISTER;;FEB 19, 2003
+2 ;
EN ;
+1 IF $DATA(IOF)
WRITE @IOF
+2 WRITE !!,$$CTR^BATU("*** List Asthma Patient's Asthma Visit History ***"),!!
+3 WRITE "This report will print the Asthma Visit History and Asthma Medication History",!,"for a patient on the Asthma Register.",!
+4 SET DIC="^BATREG("
SET DIC(0)="AEMQ"
DO ^DIC
+5 IF Y=-1
DO EXIT
QUIT
+6 SET DFN=+Y
+7 WRITE !
ZIS ;
+1 WRITE !
SET DIR(0)="S^P:PRINT Output;B:BROWSE Output on Screen"
SET DIR("A")="Do you wish to"
SET DIR("B")="P"
KILL DA
DO ^DIR
KILL DIR
+2 IF $DATA(DIRUT)
DO EXIT
QUIT
+3 SET BATOPT=Y
+4 IF Y="B"
DO BROWSE
DO EXIT
QUIT
+5 SET XBRP="PRINT^BATVSUM"
SET XBRC=""
SET XBRX="EXIT^BATVSUM"
SET XBNS="BAT;DFN"
+6 DO ^XBDBQUE
+7 DO EXIT
+8 QUIT
BROWSE ;
+1 SET XBRP="VIEWR^XBLM(""PRINT^BATVSUM"")"
+2 SET XBRC=""
SET XBRX="EXIT^BATVSUM"
SET XBIOP=0
DO ^XBDBQUE
+3 QUIT
EXIT ;
+1 DO EN^XBVK("BAT")
+2 DO ^XBFMK
+3 QUIT
S(Y,F,C,T) ;set up array
+1 IF '$GET(F)
SET F=0
+2 IF '$GET(T)
SET T=0
+3 NEW %,X
+4 ;blank lines
+5 FOR F=1:1:F
SET X=""
DO S1
+6 SET X=Y
+7 IF $GET(C)
SET L=$LENGTH(Y)
SET T=(80-L)/2
Begin DoDot:1
+8 FOR %=1:1:(T-1)
SET X=" "_X
End DoDot:1
DO S1
QUIT
+9 FOR %=1:1:T
SET X=" "_Y
+10 DO S1
+11 QUIT
S1 ;
+1 SET %=$PIECE(^TMP("BATAST",$JOB,"DCS",0),U)+1
SET $PIECE(^TMP("BATAST",$JOB,"DCS",0),U)=%
+2 SET ^TMP("BATAST",$JOB,"DCS",%)=X
+3 QUIT
PRINT ;
+1 ;gather up data
DO EP(DFN)
+2 KILL ^TMP("BATAST",$JOB)
+3 QUIT
EP(DFN) ;asthma register summary
+1 DO EP2(DFN)
W ;write out array
+1 IF $DATA(IOF)
WRITE @IOF
+2 KILL BATQUIT
+3 SET BATX=0
FOR
SET BATX=$ORDER(^TMP("BATAST",$JOB,"DCS",BATX))
IF BATX'=+BATX!($DATA(BATQUIT))
QUIT
Begin DoDot:1
+4 IF $Y>(IOSL-3)
DO HEADER
IF $DATA(BATQUIT)
QUIT
+5 WRITE !,^TMP("BATAST",$JOB,"DCS",BATX)
+6 QUIT
End DoDot:1
+7 IF $DATA(BATQUIT)
SET BATSQIT=1
+8 DO EOJ
+9 QUIT
+10 ;
EOJ ;
+1 KILL BATX,BATQUIT,BATY,BATSDFN,BATSBEG,BATSTOB,BATSUPI,BATSED,BATTOBN,BATTOB
+2 KILL N,%,T,F,X,Y,B,C,E,F,H,L,N,P,T,W
+3 QUIT
+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 BATQUIT=""
QUIT
HEAD1 ;
+1 IF $DATA(IOF)
WRITE @IOF
+2 QUIT
EP2(BATSDFN) ;EP - PASS DFN get back array of patient care summary
+1 ;at this point you are stuck with ^TMP("BATAST",$J,"DCS"
+2 KILL ^TMP("BATAST",$JOB,"DCS")
+3 SET ^TMP("BATAST",$JOB,"DCS",0)=0
+4 DO SETARRAY
+5 QUIT
SETARRAY ;set up array containing dm care summary
+1 SET X="****** CONFIDENTIAL PATIENT INFORMATION -- "_$$HTE^XLFDT($HOROLOG)_" ["_$PIECE(^VA(200,DUZ,0),U,2)_" ] ******"
DO S(X)
+2 SET X="ASTHMA PATIENT CARE SUMMARY Report Date: "_$$FMTE^XLFDT(DT)
DO S(X,1)
+3 SET X=$PIECE(^DPT(DFN,0),U)
SET $EXTRACT(X,35)="HRN: "_$$HRN^AUPNPAT(DFN,DUZ(2))
DO S(X,1)
+4 SET X="DOB: "_$$DOB^AUPNPAT(DFN,"E")_" Age: "_$$AGE^AUPNPAT(DFN)_" "_$$SEX^AUPNPAT(DFN)
SET Y=$$VAL^XBDIQ1(90181.01,DFN,.02)
SET $EXTRACT(X,35)="Asthma Register Status: "_$SELECT(Y]"":Y,1:"NOT ON REGISTER")
DO S(X)
+5 SET X="Problem List: "
+6 ;get problem list # and narrative
SET Y=$$PLAST^BATU(DFN,2)
+7 IF Y=""
SET Y="ASTHMA IS NOT ON THIS PATIENT'S PROBLEM LIST"
+8 SET X=X_Y
DO S(X)
+9 SET X="Primary Care Provider: "_$$VAL^XBDIQ1(9000001,DFN,.14)
DO S(X)
+10 SET X="Last Asthma Visit: "_$$LASTAV^BATU(DFN,3)
SET $EXTRACT(X,35)="Calculated Next Due: "_$$FMTE^XLFDT($$NEXT^BATU(DFN))
DO S(X)
+11 SET BATPBF=$$LASTPBF^BATU(DFN)
+12 IF BATPBF]""
SET X="Personal Best Peak Flow "_BATPBF_" liters/minute on "_$$LASTPBF^BATU(DFN,2)
DO S(X,1)
+13 IF BATPBF=""
SET X="Personal Best Peak Flow NOT documented. NEEDS TO BE REVIEWED"
DO S(X,1)
+14 SET X="Peak Flow Zones"
SET $EXTRACT(X,20)="Green (80-100%)"
SET $EXTRACT(X,39)=$$GREEN(BATPBF)
DO S(X,1)
+15 SET X=""
SET $EXTRACT(X,20)="Yellow (50-79%)"
SET $EXTRACT(X,39)=$$YELLOW(BATPBF)
DO S(X)
+16 SET X=""
SET $EXTRACT(X,20)="Red (< 50%)"
SET $EXTRACT(X,39)=$$RED(BATPBF)
DO S(X)
+17 SET Y=$$LASTSEV^BATU(DFN,5)
+18 IF Y=""
SET X="Severity NOT DOCUMENTED, NEEDS TO BE REVIEWED"
DO S(X,1)
+19 IF Y]""
SET X="Severity "_Y_" documented on "_$$LASTSEV^BATU(DFN,3)
DO S(X,1)
+20 SET Y=$$LASTAM^BATU(DFN,2)
IF Y]""
SET X="Date of Last Asthma Management Plan: "_Y
DO S(X,1)
+21 IF Y=""
SET X="Date of Last Asthma Managment Plan: NEEDS TO BE REVIEWED"
DO S(X,1)
+22 SET X="Triggers (Last Documented Value)"
DO S(X,1)
+23 SET X=""
SET Y=$$LASTETS^BATU(DFN,1)
SET $EXTRACT(X,8)="ETS"
SET $EXTRACT(X,28)=$SELECT(Y]"":Y,1:"NOT DOCUMENTED, NEEDS TO BE REVIEWED")
SET $EXTRACT(X,35)=$SELECT(Y]"":$$LASTETS^BATU(DFN,2),1:"")
DO S(X)
+24 SET X=""
SET Y=$$LASTPARM^BATU(DFN,1)
SET $EXTRACT(X,8)="PARTICULATE MATTER"
SET $EXTRACT(X,28)=$SELECT(Y]"":Y,1:"NOT DOCUMENTED, NEEDS TO BE REVIEWED")
SET $EXTRACT(X,35)=$SELECT(Y]"":$$LASTPARM^BATU(DFN,2),1:"")
DO S(X)
+25 SET X=""
SET Y=$$LASTDM^BATU(DFN,1)
SET $EXTRACT(X,8)="DUST MITE"
SET $EXTRACT(X,28)=$SELECT(Y]"":Y,1:"NOT DOCUMENTED, NEEDS TO BE REVIEWED")
SET $EXTRACT(X,35)=$SELECT(Y]"":$$LASTDM^BATU(DFN,2),1:"")
DO S(X)
+26 SET Y=$$LASTHF^BATSUM(DFN,"TOBACCO")
SET X="Last Recorded TOBACCO Health Factor: "_$PIECE(Y,U,2)_" "_$$FMTE^XLFDT($PIECE(Y,U))
DO S(X,1)
+27 DO LAST5
+28 SET X="Last 5 Asthma Visits - LUNG FUNCTION"
DO S(X,1)
+29 SET X=""
SET $EXTRACT(X,3)="DATE"
SET $EXTRACT(X,20)="FEV 1"
SET $EXTRACT(X,38)="FEF 25-75"
SET $EXTRACT(X,56)="PEF/Best PF"
DO S(X)
+30 SET X=""
SET $PIECE(X,"-",75)=""
DO S(X)
+31 IF '$DATA(BATL)
SET X="NO ASTHMA VISITS ON FILE"
DO S(X)
GOTO N
+32 SET Y=0
FOR
SET Y=$ORDER(BATL(Y))
IF Y'=+Y
QUIT
SET E=BATL(Y)
Begin DoDot:1
+33 SET X=""
SET $EXTRACT(X,3)=$$FMTE^XLFDT($PIECE($PIECE(^AUPNVSIT($PIECE(^AUPNVAST(E,0),U,3),0),U),"."),"1D")
SET $EXTRACT(X,20)=$PIECE(^AUPNVAST(E,0),U,5)_" % predicted"
+34 SET $EXTRACT(X,38)=$PIECE(^AUPNVAST(E,0),U,6)_" % predicted"
SET $EXTRACT(X,56)=$PIECE(^AUPNVAST(E,0),U,7)_" liters/minute"
DO S(X)
End DoDot:1
N ;more stuff
+1 SET Y=$$NREL^BATU(DFN,$$FMTE^XLFDT($$FMADD^XLFDT(DT,-365)),$$FMTE^XLFDT(DT))
+2 SET X="Number of Reliever Fills in past 12 months: "_Y
DO S(X,1)
+3 ;last 5 medication prescriptions filled
+4 SET T=$ORDER(^ATXAX("B","BAT ASTHMA RELIEVER MEDS",0))
+5 IF 'T
SET X="BAT ASTHMA RELIEVER MEDS taxonomy missing - cannot display meds"
DO S(X,1)
GOTO COMN
+6 SET T=$ORDER(^ATXAX("B","BAT ASTHMA CONTROLLER MEDS",0))
+7 IF 'T
SET X="BAT ASTHMA CONTROLLER MEDS taxonomy missing - cannot display meds"
DO S(X,1)
GOTO COMN
+8 SET T=$ORDER(^ATXAX("B","BAT ASTHMA INHALED STEROIDS",0))
+9 IF 'T
SET X="BAT ASTHMA INHALED STEROIDS MEDS taxonomy missing - cannot display meds"
DO S(X,1)
GOTO COMN
+10 DO LAST1YRM
+11 IF '$DATA(BATL)
SET X="<< No Asthma Medications found. >>"
DO S(X,1)
GOTO COMN
+12 SET X=""
SET $EXTRACT(X,3)="-----------ASTHMA MEDICATIONS (PRESCRIPTIONS FILLED IN PAST YEAR)----------"
DO S(X,1)
+13 SET D=0
FOR
SET D=$ORDER(BATL(D))
IF D'=+D
QUIT
Begin DoDot:1
+14 SET E=0
FOR
SET E=$ORDER(BATL(D,E))
IF E'=+E
QUIT
SET N=^AUPNVMED(E,0)
Begin DoDot:2
+15 SET BATD=$$FMTE^XLFDT($PIECE(^AUPNVSIT($PIECE(N,U,3),0),U),"2D")
+16 SET BATDC=$PIECE(N,U,8)
SET BATDYS=$PIECE(N,U,7)
SET BATMFX=$SELECT($PIECE(N,U,4)="":+N,1:$PIECE(N,U,4))
IF BATDYS=""
SET BATDYS=30
SET BATRX=$SELECT($DATA(^PSRX("APCC",E)):$ORDER(^(E,0)),1:0)
+17 SET BATCRN=$SELECT(+BATRX:$DATA(^PS(55,DFN,"P","CP",BATRX)),1:0)
+18 SET BATQTY=$PIECE(N,U,6)
SET BATSIG=$PIECE(N,U,5)
+19 SET BATDTM=$PIECE($PIECE(^AUPNVSIT($PIECE(N,U,3),0),U),".")
SET BATEXP=""
+20 SET X=$$FMDIFF^XLFDT(DT,BATDTM)
+21 IF X>BATDYS
SET Y=$$FMADD^XLFDT(BATDTM,BATDYS)
SET BATEXP="-- Ran out "_$$FMTE^XLFDT(Y,"2D")
+22 SET BATMED=$SELECT($PIECE(N,U,4)="":$PIECE(^PSDRUG(BATMFX,0),U),1:$PIECE(N,U,4))
+23 IF BATDC
SET Y=$$FMTE^XLFDT(BATDC,"2D")
SET BATEXP="-- D/C "_Y
+24 SET BATORTS=$GET(^AUPNVMED(E,11))
+25 IF BATORTS["RETURNED TO STOCK"
IF BATDC
SET BATEXP="--RTS "_Y
+26 DO SIG
SET BATSIG=BATSSGY
+27 DO REF
IF BATREF
SET BATSIG=BATSIG_" "_BATREF_$SELECT(BATREF=1:" refill",1:" refills")_" left."
+28 SET X=BATD
SET $EXTRACT(X,9)=$SELECT(BATCRN:"(C)",1:"")
SET $EXTRACT(X,13)=BATMED_" #"_BATQTY_" ("_BATDYS_" days) "_BATEXP
DO S(X)
+29 SET X=""
SET $EXTRACT(X,14)=$EXTRACT(BATSIG,1,65)
DO S(X)
+30 IF $LENGTH(BATSIG)>65
SET X=""
SET $EXTRACT(X,14)=$EXTRACT(BATSIG,66,999)
DO S(X)
+31 QUIT
End DoDot:2
+32 QUIT
End DoDot:1
E ;
+1 KILL BATEDUC
DO EDUC^BATSUM(DFN,.BATEDUC)
+2 IF $DATA(BATEDUC)
Begin DoDot:1
+3 SET X="Last of each ASTHMA Patient Education done:"
DO S(X,1)
+4 SET N=""
FOR
SET N=$ORDER(BATEDUC(N))
IF N=""
QUIT
SET X=" "_N
SET $EXTRACT(X,50)=$$FMTE^XLFDT(BATEDUC(N))
DO S(X)
End DoDot:1
COMN ;if comments/notes in register print them
+1 IF $ORDER(^BATREG(DFN,11,0))
Begin DoDot:1
+2 SET X=""
SET $EXTRACT(X,3)="Comments/Notes from Register:"
DO S(X,1)
+3 KILL BATAR
DO ENP^XBDIQ1(90181.01,DFN,1100,"BATAR(","E")
+4 SET F=0
FOR
SET F=$ORDER(BATAR(1100,F))
IF F'=+F
QUIT
SET X=""
SET $EXTRACT(X,5)=BATAR(1100,F)
DO S(X)
End DoDot:1
N1 ;
+1 SET X=""
DO S(X,1)
+2 QUIT
SIG ;CONSTRUCT THE FULL TEXT FROM THE ENCODED SIG
+1 SET BATSSGY=""
FOR BATSP=1:1:$LENGTH(BATSIG," ")
SET X=$PIECE(BATSIG," ",BATSP)
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(BATSIG," ",BATSP-1)
SET Y=$EXTRACT(Y,$LENGTH(Y))
IF Y>1
SET X=$PIECE(^(9),"^",1)
+3 SET BATSSGY=BATSSGY_X_" "
End DoDot:1
+4 QUIT
+5 ;
REF ;DETERMINE THE NUMBER OF REFILLS REMAINING
+1 IF 'BATRX
SET BATREF=0
QUIT
+2 SET BATRFL=$PIECE(^PSRX(BATRX,0),U,9)
SET BATREF=0
FOR
SET BATREF=$ORDER(^PSRX(BATRX,1,BATREF))
IF 'BATREF
QUIT
SET BATRFL=BATRFL-1
+3 SET BATREF=BATRFL
+4 QUIT
GREEN(V) ;
+1 NEW P,P1
+2 SET P=$JUSTIFY((V*.80),3,0)
SET P1=V
+3 QUIT P_"-"_V_" liters/minute"
YELLOW(V) ;
+1 NEW P,P1
+2 SET P=$JUSTIFY((V*.50),3,0)
SET P1=$JUSTIFY((V*.79),3,0)
+3 QUIT P_"-"_P1_" liters/minute"
RED(V) ;
+1 NEW P,P1
+2 SET P=$JUSTIFY((V*.50),3,0)
+3 QUIT "< "_P_" liters/minute"
+4 ;
LAST1YRM ;
+1 NEW T,T1,T2,E,D,Y,M
+2 SET T=$ORDER(^ATXAX("B","BAT ASTHMA RELIEVER MEDS",0))
+3 SET T1=$ORDER(^ATXAX("B","BAT ASTHMA INHALED STEROIDS",0))
+4 SET T2=$ORDER(^ATXAX("B","BAT ASTHMA CONTROLLER MEDS",0))
+5 KILL BATL
+6 SET E=9999999-$$FMADD^XLFDT(DT,-365)
+7 SET D=0
FOR
SET D=$ORDER(^AUPNVMED("AA",DFN,D))
IF D'=+D!(D>E)
QUIT
Begin DoDot:1
+8 SET M=0
FOR
SET M=$ORDER(^AUPNVMED("AA",DFN,D,M))
IF M'=+M
QUIT
SET Y=$PIECE(^AUPNVMED(M,0),U)
IF $DATA(^ATXAX(T,21,"B",Y))!($DATA(^ATXAX(T1,21,"B",Y)))!($DATA(^ATXAX(T2,21,"B",Y)))
SET BATL(D,M)=""
+9 QUIT
End DoDot:1
+10 QUIT
LAST5 ;
+1 ;get last 2 years worth
+2 NEW EDATE
+3 SET EDATE=$$FMADD^XLFDT(DT,-(365*2))
+4 SET EDATE=9999999-EDATE
+5 KILL BATL
+6 NEW D,E,C
SET (D,C)=0
FOR
SET D=$ORDER(^AUPNVAST("AA",DFN,D))
IF D'=+D!(D>EDATE)
QUIT
Begin DoDot:1
+7 KILL BATL1
SET E=0
FOR
SET E=$ORDER(^AUPNVAST("AA",DFN,D,E))
IF E'=+E
QUIT
Begin DoDot:2
+8 SET BATL1(9999999-E)=E
End DoDot:2
+9 SET E=0
FOR
SET E=$ORDER(BATL1(E))
IF E'=+E
QUIT
SET BATL(E)=BATL1(E)
SET C=C+1
+10 QUIT
End DoDot:1
+11 QUIT
