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
Q
BROWSE ;
S XBRP="VIEWR^XBLM(""PRINT^BATRP10"")"
S XBRC="PROC^BATRP10",XBRX="EXIT^BATRP10",XBIOP=0 D ^XBDBQUE
Q
EXIT ;
D EN^XBVK("BAT")
Q
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
Q
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
Q
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
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
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)," ","-")
Q
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
+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
+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
