Routine: BATRP10

BATRP10 ; IHS/CMI/LAB - master list of all active patients ;

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

START ;

 D EXIT

 W:$D(IOF) @IOF

 W !!,$$CTR^BATU("% OF PERSISTENT PATIENTS BY AGE GROUP WHO ARE OLDER THAN 6")

 W !,$$CTR^BATU("WITH SPIROMETRY DOCUMENTED WITHIN A DATE RANGE")

 W !!,"This report will give a % of persistent asthma register patients",!,"who have spirometry documented in a date range specified by the user.",!,"The patient must be 6 years old at the beginning of the date range.",!

STAT ;

 S BATS=""

 S DIR(0)="90181.01,.02",DIR("A")="List Patients with which Register Status",DIR("B")="A" KILL DA D ^DIR KILL DIR

 I $D(DIRUT) D EXIT Q

 I Y="" D EXIT Q

 S BATS=Y,BATSF=Y(0)

DATES ;

 S (BATBD,BATED)=""

BD ;get beginning date

 W ! S DIR(0)="D^::EP",DIR("A")="Enter Beginning Date of Date Range" D ^DIR K DIR S:$D(DUOUT) DIRUT=1

 I $D(DIRUT) G STAT

 S BATBD=Y

ED ;get ending date

 W ! S DIR(0)="DA^::EP",DIR("A")="Enter Ending Date of Date Range:  " S Y=BATBD D DD^%DT S Y="" D ^DIR K DIR S:$D(DUOUT) DIRUT=1

 I $D(DIRUT) G BD

 S BATED=Y

 S X1=BATBD,X2=-1 D C^%DTC S BATSD=X

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^BATRP10",XBRC="PROC^BATRP10",XBRX="EXIT^BATRP10",XBNS="BAT"

 D ^XBDBQUE

 D EXIT

BROWSE ;

 S XBRP="VIEWR^XBLM(""PRINT^BATRP10"")"

 S XBRC="PROC^BATRP10",XBRX="EXIT^BATRP10",XBIOP=0 D ^XBDBQUE

EXIT ;

 D EN^XBVK("BAT")

PROC ;

 S (BAT1D,BAT1N,BAT2D,BAT2N,BAT3D,BAT3N)=0

 S BATJ=$J,BATH=$H

 S BATX=0 F  S BATX=$O(^BATREG(BATX)) Q:BATX'=+BATX  D

 .I $$DOD^AUPNPAT(BATX)]"" Q  ;DECEASED

 .I $P(^BATREG(BATX,0),U,2)'=BATS Q

 .I $$LASTSEVD^BATU(BATX,1,BATED)=""!($$LASTSEVD^BATU(BATX,1,BATED)=1) Q

 .S BATAGE=$$AGE^AUPNPAT(BATX,BATBD)

 .Q:BATAGE<6  ;6 years and older

 .I BATAGE=6!(BATAGE=7)!(BATAGE=8) S BAT1D=BAT1D+1

 .I BATAGE>8&(BATAGE<19) S BAT2D=BAT2D+1

 .I BATAGE>18 S BAT3D=BAT3D+1

 .S X=$$SPIRO(BATX,BATBD,BATED)

 .I X,BATAGE<8 S BAT1N=BAT1N+1

 .I X,BATAGE>7,BATAGE<19 S BAT2N=BAT2N+1

 .I X,BATAGE>18 S BAT3N=BAT3N+1

PRINT ;EP

 S BATQUIT=0,BATPG=0

 D HEADER

 W !,?40,"6-8 YRS",?53,"9-18 YRS",?65,"OVER 18 YRS"

 W !!,"Number of Patients",?40,$J(BAT1D,6),?53,$J(BAT2D,6),?65,$J(BAT3D,6)

 W !,"Number with Spirometry",?40,$J(BAT1N,6),?53,$J(BAT2N,6),?65,$J(BAT3N,6)

W !

 I BAT1D W ?40,$J(((BAT1N/BAT1D)*100),5,1)_"%"

 I BAT2D W ?53,$J(((BAT2N/BAT2D)*100),5,1)_"%"

 I BAT3D W ?65,$J(((BAT3N/BAT3D)*100),5,1)_"%"

EOJ ;

 I BATOPT'="B",$E(IOST)="C",IO=IO(0) W !! S DIR(0)="EO",DIR("A")="End of report.  Press ENTER" D ^DIR K DIR S:$D(DUOUT) DIRUT=1

 W:$D(IOF) @IOF

SPIRO(P,BDATE,EDATE) ;

 ;did patient have spirometry inbetween BDATE and EDATE?

 I '$G(P) Q ""

 NEW X,Y,Z,D

 S (X,Y,Z)=0 F  S X=$O(^AUPNVAST("AC",P,X)) Q:X'=+X!(Z)  D

 .S D=$P(^AUPNVAST(X,0),U,3),D=$P($P(^AUPNVSIT(D,0),U),".")

 .Q:D<BATBD

 .Q:D>BATED

 .I $P(^AUPNVAST(X,0),U,5)]"" S Z=1 Q

 .I $P(^AUPNVAST(X,0),U,6)]"" S Z=1

.Q

Q Z

HEADER ;EP

 G:'BATPG HEADER1

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

HEADER1 ;

 W:$D(IOF) @IOF S BATPG=BATPG+1

 W !,$P(^VA(200,DUZ,0),U,2),?35,$$FMTE^XLFDT(DT),?70,"Page ",BATPG,!

 W $$CTR^BATU($$LOC^BATU),!

 W !,$$CTR^BATU("***  % OF PERSISTENT PATIENTS > 6 YEARS OLD WITH SPIROMETRY  ***",80),!

 S X="Register Status: "_BATSF W $$CTR^BATU(X,80),!

 I $D(BATAGET) S X="Ages: "_BATAGET W $$CTR^BATU(X,80),!

 S X="Date Range: "_$$FMTE^XLFDT(BATBD)_" - "_$$FMTE^XLFDT(BATED) W $$CTR^BATU(X,80),!

 W !,$TR($J("",80)," ","-")

BATRP10   ; IHS/CMI/LAB - master list of all active patients ;

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

 +2       ;

 +3       ;

START     ;

 +1        DO EXIT

 +2        IF $DATA(IOF)

               WRITE @IOF

 +3        WRITE !!,$$CTR^BATU("% OF PERSISTENT PATIENTS BY AGE GROUP WHO ARE OLDER THAN 6")

 +4        WRITE !,$$CTR^BATU("WITH SPIROMETRY DOCUMENTED WITHIN A DATE RANGE")

 +5        WRITE !!,"This report will give a % of persistent asthma register patients",!,"who have spirometry documented in a date range specified by the user.",!,"The patient must be 6 years old at the beginning of the date range.",!

STAT      ;

 +1        SET BATS=""

 +2        SET DIR(0)="90181.01,.02"

           SET DIR("A")="List Patients with which Register Status"

           SET DIR("B")="A"

           KILL DA

           DO ^DIR

           KILL DIR

 +3        IF $DATA(DIRUT)

               DO EXIT

               QUIT

 +4        IF Y=""

               DO EXIT

               QUIT

 +5        SET BATS=Y

           SET BATSF=Y(0)

DATES     ;

 +1        SET (BATBD,BATED)=""

BD        ;get beginning date

 +1        WRITE !

           SET DIR(0)="D^::EP"

           SET DIR("A")="Enter Beginning Date of Date Range"

           DO ^DIR

           KILL DIR

           IF $DATA(DUOUT)

               SET DIRUT=1

 +2        IF $DATA(DIRUT)

               GOTO STAT

 +3        SET BATBD=Y

ED        ;get ending date

 +1        WRITE !

           SET DIR(0)="DA^::EP"

           SET DIR("A")="Enter Ending Date of Date Range:  "

           SET Y=BATBD

           DO DD^%DT

           SET Y=""

           DO ^DIR

           KILL DIR

           IF $DATA(DUOUT)

               SET DIRUT=1

 +2        IF $DATA(DIRUT)

               GOTO BD

 +3        SET BATED=Y

 +4        SET X1=BATBD

           SET X2=-1

           DO C^%DTC

           SET BATSD=X

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^BATRP10"

           SET XBRC="PROC^BATRP10"

           SET XBRX="EXIT^BATRP10"

           SET XBNS="BAT"

 +6        DO ^XBDBQUE

 +7        DO EXIT

 +8        QUIT

BROWSE    ;

 +1        SET XBRP="VIEWR^XBLM(""PRINT^BATRP10"")"

 +2        SET XBRC="PROC^BATRP10"

           SET XBRX="EXIT^BATRP10"

           SET XBIOP=0

           DO ^XBDBQUE

 +3        QUIT

EXIT      ;

 +1        DO EN^XBVK("BAT")

 +2        QUIT

PROC      ;

 +1        SET (BAT1D,BAT1N,BAT2D,BAT2N,BAT3D,BAT3N)=0

 +2        SET BATJ=$JOB

           SET BATH=$HOROLOG

 +3        SET BATX=0

FOR

               SET BATX=$ORDER(^BATREG(BATX))

               IF BATX'=+BATX

                   QUIT

               Begin DoDot:1

 +4       ;DECEASED

                   IF $$DOD^AUPNPAT(BATX)]""

                       QUIT

 +5                IF $PIECE(^BATREG(BATX,0),U,2)'=BATS

                       QUIT

 +6                IF $$LASTSEVD^BATU(BATX,1,BATED)=""!($$LASTSEVD^BATU(BATX,1,BATED)=1)

                       QUIT

 +7                SET BATAGE=$$AGE^AUPNPAT(BATX,BATBD)

 +8       ;6 years and older

                   IF BATAGE<6

                       QUIT

 +9                IF BATAGE=6!(BATAGE=7)!(BATAGE=8)

                       SET BAT1D=BAT1D+1

 +10               IF BATAGE>8&(BATAGE<19)

                       SET BAT2D=BAT2D+1

 +11               IF BATAGE>18

                       SET BAT3D=BAT3D+1

 +12               SET X=$$SPIRO(BATX,BATBD,BATED)

 +13               IF X

                       IF BATAGE<8

                           SET BAT1N=BAT1N+1

 +14               IF X

                       IF BATAGE>7

                           IF BATAGE<19

                               SET BAT2N=BAT2N+1

 +15               IF X

                       IF BATAGE>18

                           SET BAT3N=BAT3N+1

               End DoDot:1

 +16       QUIT

PRINT     ;EP

 +1        SET BATQUIT=0

           SET BATPG=0

 +2        DO HEADER

 +3        WRITE !,?40,"6-8 YRS",?53,"9-18 YRS",?65,"OVER 18 YRS"

 +4        WRITE !!,"Number of Patients",?40,$JUSTIFY(BAT1D,6),?53,$JUSTIFY(BAT2D,6),?65,$JUSTIFY(BAT3D,6)

 +5        WRITE !,"Number with Spirometry",?40,$JUSTIFY(BAT1N,6),?53,$JUSTIFY(BAT2N,6),?65,$JUSTIFY(BAT3N,6)

 +6        WRITE !

 +7        IF BAT1D

               WRITE ?40,$JUSTIFY(((BAT1N/BAT1D)*100),5,1)_"%"

 +8        IF BAT2D

               WRITE ?53,$JUSTIFY(((BAT2N/BAT2D)*100),5,1)_"%"

 +9        IF BAT3D

               WRITE ?65,$JUSTIFY(((BAT3N/BAT3D)*100),5,1)_"%"

EOJ       ;

 +1        IF BATOPT'="B"

               IF $EXTRACT(IOST)="C"

                   IF IO=IO(0)

                       WRITE !!

                       SET DIR(0)="EO"

                       SET DIR("A")="End of report.  Press ENTER"

                       DO ^DIR

                       KILL DIR

                       IF $DATA(DUOUT)

                           SET DIRUT=1

 +2        IF $DATA(IOF)

               WRITE @IOF

 +3        QUIT

SPIRO(P,BDATE,EDATE) ;

 +1       ;did patient have spirometry inbetween BDATE and EDATE?

 +2        IF '$GET(P)

               QUIT ""

 +3        NEW X,Y,Z,D

 +4        SET (X,Y,Z)=0

FOR

               SET X=$ORDER(^AUPNVAST("AC",P,X))

               IF X'=+X!(Z)

                   QUIT

               Begin DoDot:1

 +5                SET D=$PIECE(^AUPNVAST(X,0),U,3)

                   SET D=$PIECE($PIECE(^AUPNVSIT(D,0),U),".")

 +6                IF D<BATBD

                       QUIT

 +7                IF D>BATED

                       QUIT

 +8                IF $PIECE(^AUPNVAST(X,0),U,5)]""

                       SET Z=1

                       QUIT

 +9                IF $PIECE(^AUPNVAST(X,0),U,6)]""

                       SET Z=1

 +10               QUIT

               End DoDot:1

 +11       QUIT Z

HEADER    ;EP

 +1        IF 'BATPG

               GOTO HEADER1

 +2        KILL DIR

           IF $EXTRACT(IOST)="C"

               IF IO=IO(0)

                   IF '$DATA(ZTQUEUED)

                       WRITE !

                       SET DIR(0)="EO"

                       DO ^DIR

                       KILL DIR

                       IF Y=0!(Y="^")!($DATA(DTOUT))

                           SET BATQUIT=1

                           QUIT

HEADER1   ;

 +1        IF $DATA(IOF)

               WRITE @IOF

           SET BATPG=BATPG+1

 +2        WRITE !,$PIECE(^VA(200,DUZ,0),U,2),?35,$$FMTE^XLFDT(DT),?70,"Page ",BATPG,!

 +3        WRITE $$CTR^BATU($$LOC^BATU),!

 +4        WRITE !,$$CTR^BATU("***  % OF PERSISTENT PATIENTS > 6 YEARS OLD WITH SPIROMETRY  ***",80),!

 +5        SET X="Register Status: "_BATSF

           WRITE $$CTR^BATU(X,80),!

 +6        IF $DATA(BATAGET)

               SET X="Ages: "_BATAGET

               WRITE $$CTR^BATU(X,80),!

 +7        SET X="Date Range: "_$$FMTE^XLFDT(BATBD)_" - "_$$FMTE^XLFDT(BATED)

           WRITE $$CTR^BATU(X,80),!

 +8        WRITE !,$TRANSLATE($JUSTIFY("",80)," ","-")

 +9        QUIT

BATRP10.m