BATSUM.m

BATSUM ; IHS/CMI/LAB - ;

 ;;1.0;IHS ASTHMA REGISTER;;FEB 19, 2003

 ;

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("APCHAST",$J,"DCS",0),U)+1,$P(^TMP("APCHAST",$J,"DCS",0),U)=%

 S ^TMP("APCHAST",$J,"DCS",%)=X

 Q

EP(DFN) ;PEP - ASthma register summary

 D EP2(DFN)

W ;write out array

 W:$D(IOF) @IOF

 K APCHQUIT

 S APCHX=0 F  S APCHX=$O(^TMP("APCHAST",$J,"DCS",APCHX)) Q:APCHX'=+APCHX!($D(APCHQUIT))  D

 .I $Y>(IOSL-3) D HEADER Q:$D(APCHQUIT)

 .W !,^TMP("APCHAST",$J,"DCS",APCHX)

 .Q

 I $D(APCHQUIT) S APCHSQIT=1

 D EOJ

 Q

 ;

EOJ ;

 D EN^XBVK("BAT")

 K N,%,T,F,X,Y,B,C,E,F,H,L,N,P,T,W,M,T,T1,T2,T3

 Q

HEADER ;

 I $E(IOST)="C",IO=IO(0) W ! S DIR(0)="EO" D ^DIR K DIR I Y=0!(Y="^")!($D(DTOUT)) S APCHQUIT="" Q

HEAD1 ;

 W:$D(IOF) @IOF

 W !,APCHSHDR

 W !,"ASTHMA PATIENT CARE SUMMARY                      Report Date:  ",$$FMTE^XLFDT(DT),!

 Q

EP2(DFN) ;EP - PASS DFN get back array of patient care summary

 ;at this point you are stuck with ^TMP("APCHAST",$J,"DCS"

 K ^TMP("APCHAST",$J,"DCS")

 S ^TMP("APCHAST",$J,"DCS",0)=0

 D SETARRAY

 Q

SETARRAY ;set up array containing dm care summary

 S X=APCHSHDR 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,1)

 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)

 ;smoking heath factor - LAST RECORDED

 S Y=$$LASTHF(DFN,"TOBACCO"),X="Last Recorded TOBACCO Health Factor: "_$P(Y,U,2)_"   "_$$FMTE^XLFDT($P(Y,U))  D S(X,1)

V 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 (ALL 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),"5D")

 ..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) 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

 K BATEDUC D EDUC(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)

 K BATAR,BATSIG,BATSP,BATSSGY

 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 ;

 K BATL

 NEW D,E,C S (D,C)=0 F  S D=$O(^AUPNVAST("AA",DFN,D)) Q:D'=+D!(C>4)  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!(C>4)  S BATL(E)=BATL1(E),C=C+1

 .Q

 Q

EDUC(P,DATA) ;EP pass back array of all asthma educ topics

 ;any topic that begins with ASM or 493

 K DATA

 I '$G(P) Q

 NEW BATE,X,E,%,G,A,N,D

 K ^TMP($J,"A")

 S A="^TMP($J,""A"","

 S X=P_"^ALL EDUC;" S E=$$START1^APCLDF(X,A)

 I '$D(^TMP($J,"A",1)) Q

 S %=0 F  S %=$O(^TMP($J,"A",%)) Q:%'=+%  D

 .S N=$P(^TMP($J,"A",%),U,2),D=$P(^TMP($J,"A",%),U,1)

 .I $E(N,1,3)="ASM"!($E(N,1,3)="493") D

 ..S BATE(N,9999999-D)=""

 S N="" F  S N=$O(BATE(N)) Q:N=""  S DATA(N)=(9999999-$O(BATE(N,0)))

 K BATE,^TMP($J,"A")

 Q

LASTHF(P,C,F) ;EP - get last factor in category C for patient P

 I '$G(P) Q ""

 I $G(C)="" Q ""

 I $G(F)="" S F=""

 S C=$O(^AUTTHF("B",C,0)) ;ien of category passed

 I '$G(C) Q ""

 NEW H,D,O S H=0 K O

 F  S H=$O(^AUTTHF("AC",C,H))  Q:'+H  D

 .  Q:'$D(^AUPNVHF("AA",P,H))

 .  S D=$O(^AUPNVHF("AA",P,H,""))

 .  Q:'D

 .  S O(D)=$O(^AUPNVHF("AA",P,H,D,""))

 .  Q

 S D=$O(O(0))

 I D="" Q D

 I F="S" Q $P($G(^AUPNVHF(O(D),0)),U,6)

 Q 9999999-D_"^"_$$VAL^XBDIQ1(9000010.23,O(D),.01)

 ;

BATSUM    ; IHS/CMI/LAB - ;

 +1       ;;1.0;IHS ASTHMA REGISTER;;FEB 19, 2003

 +2       ;

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("APCHAST",$JOB,"DCS",0),U)+1

           SET $PIECE(^TMP("APCHAST",$JOB,"DCS",0),U)=%

 +2        SET ^TMP("APCHAST",$JOB,"DCS",%)=X

 +3        QUIT 

EP(DFN)   ;PEP - ASthma register summary

 +1        DO EP2(DFN)

W         ;write out array

 +1        IF $DATA(IOF)

               WRITE @IOF

 +2        KILL APCHQUIT

 +3        SET APCHX=0

           FOR 

               SET APCHX=$ORDER(^TMP("APCHAST",$JOB,"DCS",APCHX))

               IF APCHX'=+APCHX!($DATA(APCHQUIT))

                   QUIT 

               Begin DoDot:1

 +4                IF $Y>(IOSL-3)

                       DO HEADER

                       IF $DATA(APCHQUIT)

                           QUIT 

 +5                WRITE !,^TMP("APCHAST",$JOB,"DCS",APCHX)

 +6                QUIT 

               End DoDot:1

 +7        IF $DATA(APCHQUIT)

               SET APCHSQIT=1

 +8        DO EOJ

 +9        QUIT 

 +10      ;

EOJ       ;

 +1        DO EN^XBVK("BAT")

 +2        KILL N,%,T,F,X,Y,B,C,E,F,H,L,N,P,T,W,M,T,T1,T2,T3

 +3        QUIT 

HEADER    ;

 +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 APCHQUIT=""

                       QUIT 

HEAD1     ;

 +1        IF $DATA(IOF)

               WRITE @IOF

 +2        WRITE !,APCHSHDR

 +3        WRITE !,"ASTHMA PATIENT CARE SUMMARY                      Report Date:  ",$$FMTE^XLFDT(DT),!

 +4        QUIT 

EP2(DFN)  ;EP - PASS DFN get back array of patient care summary

 +1       ;at this point you are stuck with ^TMP("APCHAST",$J,"DCS"

 +2        KILL ^TMP("APCHAST",$JOB,"DCS")

 +3        SET ^TMP("APCHAST",$JOB,"DCS",0)=0

 +4        DO SETARRAY

 +5        QUIT 

SETARRAY  ;set up array containing dm care summary

 +1        SET X=APCHSHDR

           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,1)

 +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      ;smoking heath factor - LAST RECORDED

 +27       SET Y=$$LASTHF(DFN,"TOBACCO")

           SET X="Last Recorded TOBACCO Health Factor: "_$PIECE(Y,U,2)_"   "_$$FMTE^XLFDT($PIECE(Y,U))

           DO S(X,1)

V          DO LAST5

 +1        SET X="Last 5 Asthma Visits - LUNG FUNCTION"

           DO S(X,1)

 +2        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)

 +3        SET X=""

           SET $PIECE(X,"-",75)=""

           DO S(X)

 +4        IF '$DATA(BATL)

               SET X="NO ASTHMA VISITS ON FILE"

               DO S(X)

               GOTO N

 +5        SET Y=0

           FOR 

               SET Y=$ORDER(BATL(Y))

               IF Y'=+Y

                   QUIT 

               SET E=BATL(Y)

               Begin DoDot:1

 +6                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"

 +7                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 (ALL 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),"5D")

 +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)

                               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)