BATRPT4 ; 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("PATIENTS WITH 4 OR MORE RELIEVER REFILLS IN 150 DAYS")
W !!,"This report will list all patients who have had 4 or more refills of",!,"reliever medication a user defined 150 day period.",!,!,"All patients will be reviewed, not just those on the Asthma Register.",!
W !!,"This report reviewd the entire patient file and may take several hours to",!,"run depending on the size of the patient database.",!
S DIR(0)="Y",DIR("A")="Do you want to continue",DIR("B")="Y" KILL DA D ^DIR KILL DIR
I $D(DIRUT) D EXIT Q
I 'Y D EXIT Q
DATE ;
S BATED=""
S DIR(0)="D^::EP",DIR("A")="Enter the Ending Date of the 150 day period" KILL DA D ^DIR KILL DIR
I $D(DIRUT) D EXIT Q
S BATED=Y
AGE ;Age Screening
K BATAGE,BATAGET
W ! S DIR(0)="YO",DIR("A")="Would you like to restrict the report by Patient age range",DIR("B")="YES"
S DIR("?")="If you wish to include visits from ALL age ranges, anwser No. If you wish to include visits for only patients within a particular age range, enter Yes."
D ^DIR K DIR
G:$D(DIRUT) DATE
I 'Y G SORT
;
AGER ;Age Screening
W !
S DIR(0)="FO^1:7",DIR("A")="Enter an Age Range (e.g. 5-12,1-1)" D ^DIR
I Y="" W !!,"No age range entered." G AGE
I Y'?1.3N1"-"1.3N W !!,$C(7),$C(7),"Enter a numeric range in the format nnn-nnn. e.g. 0-5, 0-99, 5-20." G AGER
S BATAGET=Y
;
;
SORT ;
S BATSORT=""
S DIR(0)="S^N:Patient Name;D:Patient AGE;V:Patient's Next Asthma Visit Due Date;A:Last Asthma Severity;L:Last Asthma Visit",DIR("A")="Sort List by",DIR("B")="N" KILL DA D ^DIR KILL DIR
I $D(DIRUT) D EXIT Q
S BATSORT=Y
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^BATRPT4",XBRC="PROC^BATRPT4",XBRX="EXIT^BATRPT4",XBNS="BAT"
D ^XBDBQUE
D EXIT
Q
BROWSE ;
S XBRP="VIEWR^XBLM(""PRINT^BATRPT4"")"
S XBRC="PROC^BATRPT4",XBRX="EXIT^BATRPT4",XBIOP=0 D ^XBDBQUE
Q
EXIT ;
D EN^XBVK("BAT")
Q
PROC ;
S BATJ=$J,BATH=$H
D XTMP^BATU("BATRPT4","ASTHMA REGISTER DUE LIST")
S BATX=0 F S BATX=$O(^AUPNPAT(BATX)) Q:BATX'=+BATX D
.I $$DOD^AUPNPAT(BATX)]"" Q ;DECEASED
.S BATAGE=$$AGE^AUPNPAT(BATX,$$FMADD^XLFDT(BATED,-150))
.I $D(BATAGET),BATAGE>$P(BATAGET,"-",2) Q
.I $D(BATAGET),BATAGE<$P(BATAGET,"-") Q
.S BATCNT=$$GETMED(BATX,BATED)
.I BATCNT<4 Q ;didn't have 4 or more
.D GETSORT
.S ^XTMP("BATRPT4",BATJ,BATH,"PATIENTS",BATSRTV,BATX)=BATCNT
.Q
Q
GETSORT ;
S BATSRTV=""
I BATSORT="N" S BATSRTV=$P(^DPT(BATX,0),U) Q
I BATSORT="D" S BATSRTV=$$AGE^AUPNPAT(BATX) I BATSRTV="" S BATSRTV="--" Q
I BATSORT="A" S BATSRTV=$$LASTSEV^BATU(BATX) I BATSRTV="" S BATSRTV="--" Q
I BATSORT="V" S BATSRTV=$P($G(^BATREG(BATX,0)),U,7) I BATSRTV="" S BATSRTV="--"
I BATSORT="L" S BATSRTV=$P($G(^BATREG(BATX,0)),U,6) I BATSRTV="" S BATSRTV="--"
Q
GETMED(P,EDATE) ;all reliever meds count up
NEW X,BATL,E,BDATE
K BATL
S BDATE=$$FMADD^XLFDT(EDATE,-150)
S X=P_"^ALL MEDS [BAT ASTHMA RELIEVER MEDS"_";DURING "_$$FMTE^XLFDT(BDATE)_"-"_$$FMTE^XLFDT(EDATE) S E=$$START1^APCLDF(X,"BATL(")
I '$D(BATL(1)) Q 0
NEW C S (X,C)=0 F S X=$O(BATL(X)) Q:X'=+X S C=C+1
Q C
;
PRINT ;EP
S BATQUIT=0,BATPG=0
D HEADER
I '$D(^XTMP("BATRPT4",BATJ,BATH,"PATIENTS")) W !!,"No patients to list" G EOJ
S BATST="" F S BATST=$O(^XTMP("BATRPT4",BATJ,BATH,"PATIENTS",BATST)) Q:BATST=""!(BATQUIT) D
.S BATX=0 F S BATX=$O(^XTMP("BATRPT4",BATJ,BATH,"PATIENTS",BATST,BATX)) Q:BATX'=+BATX!(BATQUIT) D
..I $Y>(IOSL-4) D HEADER Q:BATQUIT
..W !,$E($P(^DPT(BATX,0),U),1,22),?23,$$HRN^AUPNPAT(BATX,DUZ(2)),?30,$$AGE^AUPNPAT(BATX,DT,"R")
..W ?37,$E($$LASTSEV^BATU(BATX,5),1,17),?55,$$FMTE^XLFDT($P($P($G(^BATREG(BATX,0)),U,6),".")),?68,$$FMTE^XLFDT($P($P($G(^BATREG(BATX,0)),U,7),"."))
..I '$D(^BATREG(BATX,0)) W !?5,"Patient NOT on Asthma Register"
..W !?5,"Number of Reliever Refills: ",^XTMP("BATRPT4",BATJ,BATH,"PATIENTS",BATST,BATX)
..Q
.Q
EOJ ;
I BATOPT'="B",$E(IOST)="C",IO=IO(0) S DIR(0)="EO",DIR("A")="End of report. Press ENTER" D ^DIR K DIR S:$D(DUOUT) DIRUT=1
K ^XTMP("BATRPT4",BATJ,BATH),BATX
W:$D(IOF) @IOF
Q
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("*** PATIENTS WITH 4 OR MORE RELIEVER MED REFILLS IN 150 DAYS ***",80),!
S X="Time Period: "_$$FMTE^XLFDT($$FMADD^XLFDT(BATED,-150))_" to "_$$FMTE^XLFDT(BATED) W $$CTR^BATU(X,80),!
I $D(BATAGET) S X="Ages: "_BATAGET W $$CTR^BATU(X,80),!
W !,"PATIENT NAME",?24,"HRN",?31,"AGE",?37,"LAST SEVERITY",?55,"LAST VISIT",?68,"NEXT DUE"
W !,$TR($J("",80)," ","-")
Q
BATRPT4 ; 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("PATIENTS WITH 4 OR MORE RELIEVER REFILLS IN 150 DAYS")
+4 WRITE !!,"This report will list all patients who have had 4 or more refills of",!,"reliever medication a user defined 150 day period.",!,!,"All patients will be reviewed, not just those on the Asthma Register.",!
+5 WRITE !!,"This report reviewd the entire patient file and may take several hours to",!,"run depending on the size of the patient database.",!
+6 SET DIR(0)="Y"
SET DIR("A")="Do you want to continue"
SET DIR("B")="Y"
KILL DA
DO ^DIR
KILL DIR
+7 IF $DATA(DIRUT)
DO EXIT
QUIT
+8 IF 'Y
DO EXIT
QUIT
DATE ;
+1 SET BATED=""
+2 SET DIR(0)="D^::EP"
SET DIR("A")="Enter the Ending Date of the 150 day period"
KILL DA
DO ^DIR
KILL DIR
+3 IF $DATA(DIRUT)
DO EXIT
QUIT
+4 SET BATED=Y
AGE ;Age Screening
+1 KILL BATAGE,BATAGET
+2 WRITE !
SET DIR(0)="YO"
SET DIR("A")="Would you like to restrict the report by Patient age range"
SET DIR("B")="YES"
+3 SET DIR("?")="If you wish to include visits from ALL age ranges, anwser No. If you wish to include visits for only patients within a particular age range, enter Yes."
+4 DO ^DIR
KILL DIR
+5 IF $DATA(DIRUT)
GOTO DATE
+6 IF 'Y
GOTO SORT
+7 ;
AGER ;Age Screening
+1 WRITE !
+2 SET DIR(0)="FO^1:7"
SET DIR("A")="Enter an Age Range (e.g. 5-12,1-1)"
DO ^DIR
+3 IF Y=""
WRITE !!,"No age range entered."
GOTO AGE
+4 IF Y'?1.3N1"-"1.3N
WRITE !!,$CHAR(7),$CHAR(7),"Enter a numeric range in the format nnn-nnn. e.g. 0-5, 0-99, 5-20."
GOTO AGER
+5 SET BATAGET=Y
+6 ;
+7 ;
SORT ;
+1 SET BATSORT=""
+2 SET DIR(0)="S^N:Patient Name;D:Patient AGE;V:Patient's Next Asthma Visit Due Date;A:Last Asthma Severity;L:Last Asthma Visit"
SET DIR("A")="Sort List by"
SET DIR("B")="N"
KILL DA
DO ^DIR
KILL DIR
+3 IF $DATA(DIRUT)
DO EXIT
QUIT
+4 SET BATSORT=Y
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^BATRPT4"
SET XBRC="PROC^BATRPT4"
SET XBRX="EXIT^BATRPT4"
SET XBNS="BAT"
+6 DO ^XBDBQUE
+7 DO EXIT
+8 QUIT
BROWSE ;
+1 SET XBRP="VIEWR^XBLM(""PRINT^BATRPT4"")"
+2 SET XBRC="PROC^BATRPT4"
SET XBRX="EXIT^BATRPT4"
SET XBIOP=0
DO ^XBDBQUE
+3 QUIT
EXIT ;
+1 DO EN^XBVK("BAT")
+2 QUIT
PROC ;
+1 SET BATJ=$JOB
SET BATH=$HOROLOG
+2 DO XTMP^BATU("BATRPT4","ASTHMA REGISTER DUE LIST")
+3 SET BATX=0
FOR
SET BATX=$ORDER(^AUPNPAT(BATX))
IF BATX'=+BATX
QUIT
Begin DoDot:1
+4 ;DECEASED
IF $$DOD^AUPNPAT(BATX)]""
QUIT
+5 SET BATAGE=$$AGE^AUPNPAT(BATX,$$FMADD^XLFDT(BATED,-150))
+6 IF $DATA(BATAGET)
IF BATAGE>$PIECE(BATAGET,"-",2)
QUIT
+7 IF $DATA(BATAGET)
IF BATAGE<$PIECE(BATAGET,"-")
QUIT
+8 SET BATCNT=$$GETMED(BATX,BATED)
+9 ;didn't have 4 or more
IF BATCNT<4
QUIT
+10 DO GETSORT
+11 SET ^XTMP("BATRPT4",BATJ,BATH,"PATIENTS",BATSRTV,BATX)=BATCNT
+12 QUIT
End DoDot:1
+13 QUIT
GETSORT ;
+1 SET BATSRTV=""
+2 IF BATSORT="N"
SET BATSRTV=$PIECE(^DPT(BATX,0),U)
QUIT
+3 IF BATSORT="D"
SET BATSRTV=$$AGE^AUPNPAT(BATX)
IF BATSRTV=""
SET BATSRTV="--"
QUIT
+4 IF BATSORT="A"
SET BATSRTV=$$LASTSEV^BATU(BATX)
IF BATSRTV=""
SET BATSRTV="--"
QUIT
+5 IF BATSORT="V"
SET BATSRTV=$PIECE($GET(^BATREG(BATX,0)),U,7)
IF BATSRTV=""
SET BATSRTV="--"
+6 IF BATSORT="L"
SET BATSRTV=$PIECE($GET(^BATREG(BATX,0)),U,6)
IF BATSRTV=""
SET BATSRTV="--"
+7 QUIT
GETMED(P,EDATE) ;all reliever meds count up
+1 NEW X,BATL,E,BDATE
+2 KILL BATL
+3 SET BDATE=$$FMADD^XLFDT(EDATE,-150)
+4 SET X=P_"^ALL MEDS [BAT ASTHMA RELIEVER MEDS"_";DURING "_$$FMTE^XLFDT(BDATE)_"-"_$$FMTE^XLFDT(EDATE)
SET E=$$START1^APCLDF(X,"BATL(")
+5 IF '$DATA(BATL(1))
QUIT 0
+6 NEW C
SET (X,C)=0
FOR
SET X=$ORDER(BATL(X))
IF X'=+X
QUIT
SET C=C+1
+7 QUIT C
+8 ;
PRINT ;EP
+1 SET BATQUIT=0
SET BATPG=0
+2 DO HEADER
+3 IF '$DATA(^XTMP("BATRPT4",BATJ,BATH,"PATIENTS"))
WRITE !!,"No patients to list"
GOTO EOJ
+4 SET BATST=""
FOR
SET BATST=$ORDER(^XTMP("BATRPT4",BATJ,BATH,"PATIENTS",BATST))
IF BATST=""!(BATQUIT)
QUIT
Begin DoDot:1
+5 SET BATX=0
FOR
SET BATX=$ORDER(^XTMP("BATRPT4",BATJ,BATH,"PATIENTS",BATST,BATX))
IF BATX'=+BATX!(BATQUIT)
QUIT
Begin DoDot:2
+6 IF $Y>(IOSL-4)
DO HEADER
IF BATQUIT
QUIT
+7 WRITE !,$EXTRACT($PIECE(^DPT(BATX,0),U),1,22),?23,$$HRN^AUPNPAT(BATX,DUZ(2)),?30,$$AGE^AUPNPAT(BATX,DT,"R")
+8 WRITE ?37,$EXTRACT($$LASTSEV^BATU(BATX,5),1,17),?55,$$FMTE^XLFDT($PIECE($PIECE($GET(^BATREG(BATX,0)),U,6),".")),?68,$$FMTE^XLFDT($PIECE($PIECE($GET(^BATREG(BATX,0)),U,7),"."))
+9 IF '$DATA(^BATREG(BATX,0))
WRITE !?5,"Patient NOT on Asthma Register"
+10 WRITE !?5,"Number of Reliever Refills: ",^XTMP("BATRPT4",BATJ,BATH,"PATIENTS",BATST,BATX)
+11 QUIT
End DoDot:2
+12 QUIT
End DoDot:1
EOJ ;
+1 IF BATOPT'="B"
IF $EXTRACT(IOST)="C"
IF IO=IO(0)
SET DIR(0)="EO"
SET DIR("A")="End of report. Press ENTER"
DO ^DIR
KILL DIR
IF $DATA(DUOUT)
SET DIRUT=1
+2 KILL ^XTMP("BATRPT4",BATJ,BATH),BATX
+3 IF $DATA(IOF)
WRITE @IOF
+4 QUIT
+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("*** PATIENTS WITH 4 OR MORE RELIEVER MED REFILLS IN 150 DAYS ***",80),!
+5 SET X="Time Period: "_$$FMTE^XLFDT($$FMADD^XLFDT(BATED,-150))_" to "_$$FMTE^XLFDT(BATED)
WRITE $$CTR^BATU(X,80),!
+6 IF $DATA(BATAGET)
SET X="Ages: "_BATAGET
WRITE $$CTR^BATU(X,80),!
+7 WRITE !,"PATIENT NAME",?24,"HRN",?31,"AGE",?37,"LAST SEVERITY",?55,"LAST VISIT",?68,"NEXT DUE"
+8 WRITE !,$TRANSLATE($JUSTIFY("",80)," ","-")
+9 QUIT
