APCLBPP ; IHS/CMI/LAB - print dx by age ;
;;2.0;IHS PCC SUITE;**10,15**;MAY 14, 2009;Build 11
START ;
S APCL80="",$P(APCL80,"-",80)="-"
S (APCLPG,APCLSEXP)=0,APCLSDD=9999999-APCLSD,APCLEDD=9999999-APCLED
S Y=APCLSDD D DD^%DT S APCLSDD=Y S Y=APCLEDD D DD^%DT S APCLEDD=Y
K APCLQUIT
D
.I APCLPTOT=0 D HEAD,SELHDR W !,"NO PATIENT DATA TO REPORT",! Q
.I APCLRTYP="D" D DTLHDR D Q
..S APCLSRT="" F S APCLSRT=$O(^XTMP("APCLBP",APCLJOB,APCLBTH,"PATS",APCLSRT)) Q:APCLSRT=""!($D(APCLQUIT)) D PAT
..Q:$D(APCLQUIT)
..D:$Y>(IOSL-16) DTLHDR
..W !!,"TOTAL NUMBER OF PATIENTS: ",APCLPTOT
.D SMYHDR
.S APCLSRT=0 F S APCLSRT=$O(^XTMP("APCLBP",APCLJOB,APCLBTH,"STATS",APCLSRT)) Q:APCLSRT=""!($D(APCLQUIT)) I $D(^XTMP("APCLBP",APCLJOB,APCLBTH,"STATS",APCLSRT))>1 D STATS
.Q:$D(APCLQUIT)
.D:$Y>(IOSL-16) SMYHDR
.S APCLSRT=0 D STATS
D DONE
Q
PAT ;
S DFN=0 F S DFN=$O(^XTMP("APCLBP",APCLJOB,APCLBTH,"PATS",APCLSRT,DFN)) Q:DFN'=+DFN!($D(APCLQUIT)) S APCLX=^XTMP("APCLBP",APCLJOB,APCLBTH,"PATS",APCLSRT,DFN) D
.I $Y>(IOSL-4) D DTLHDR Q:$D(APCLQUIT)
.W ! W:APCLIDEN#10=0 $E($P(APCLX,U),1,15) W:APCLIDEN<10 ?17,$P(APCLX,U,2)
.S APCLCMTY=$P(APCLX,U,5),APCLCMTY=$S(APCLCMTY?1A.E:$E(APCLCMTY,1,10),APCLCMTY=0:"TOTAL",1:$P(APCLCMTY,"~",2))
.W ?25,$J($P(APCLX,U,3),3),?30,$P(APCLX,U,4),?35,APCLCMTY,?47,$E($P(APCLX,U,6),1,10),?61,$J($FN($P(APCLX,U,7),","),5),?71,$P(APCLX,U,8)
Q
;
; APCLBPTI - B/P type index: 1 = Systolic, 2 = Diastolic
STATS ;
I $Y>(IOSL-4) D SMYHDR Q:$D(APCLQUIT)
S APCLX=^XTMP("APCLBP",APCLJOB,APCLBTH,"STATS",APCLSRT)
S APCLTPT=$P(APCLX,U,1),APCLTOPT=$P(APCLX,U,2),APCLBPC=$P(APCLX,U,3)
F APCLBPTI=1,2 D
.S APCLBPX=^XTMP("APCLBP",APCLJOB,APCLBTH,"STATS",APCLSRT,APCLBPTI)
.S APCLTBP=$P(APCLBPX,U,1),APCLTOP=$P(APCLBPX,U,2),APCLTOBC=$P(APCLBPX,U,3),APCLTOBP=$P(APCLBPX,U,4)
.W ! W:APCLBPTI=1 ?5,$S(APCLSRT?1A.E:$E(APCLSRT,1,10),APCLSRT=0:"TOTAL",1:$P(APCLSRT,"~",2)) W:APCLBPC-APCLTOBC>0 ?19,$J(APCLTBP-APCLTOBP\(APCLBPC-APCLTOBC),3)
.W:APCLTOBC ?28,$J(APCLTOBP\APCLTOBC,3)
.I APCLBPTI=1 W ?35,$J($FN(APCLTPT-APCLTOPT,","),6),?49,$J($FN(APCLTOPT,","),6) S APCLPCT=APCLTPT-APCLTOPT/APCLTPT*100\1 W ?62,$J(APCLPCT,3),?76,$J(100-APCLPCT,3)
.W:APCLBPTI=2 !
Q
;
HEAD ;
I APCLPG,$E(IOST)="C",IO=IO(0) W ! S DIR(0)="EO" D ^DIR K DIR I Y=0!(Y="^")!($D(DTOUT)) S APCLQUIT="" Q
Q
;
SELHDR ; Header showing what was selected
W:$D(IOF) @IOF S APCLPG=APCLPG+1
W !!,$P(^VA(200,DUZ,0),"^",2),$$CENTER($P(^DIC(4,DUZ(2),0),"^"),78),?71,"Page ",APCLPG,!
W ?22,"BLOOD PRESSURE OUT OF CONTROL REPORT"
W !,$$CENTER($S(APCLRTYP="D":"LIST OF BLOOD PRESSURE OUT OF CONTROL PATIENTS",1:"BLOOD PRESSURE IN/OUT OF CONTROL STATISTICS"))
W:APCLSEAT'="" !,$$CENTER("Search Template of Patients: "_$P(^DIBT(APCLSEAT,0),U)),!
W !,$$CENTER("Report includes: "_$S('$D(APCLAGER):"ALL AGES",1:"AGES: "_APCLAGER)_", "_$S(APCLSEX="B":"MALES/FEMALES/UNKNOWN",APCLSEX="F":"FEMALES",APCLSEX="U":"UNKNOWN GENDER",APCLSEX="M":"MALES",1:"ALL GENDERS")_", ")
W !,$$CENTER($S($D(APCLCOMM):"selected",1:"ALL")_" COMMUNITIES, "_$S($D(APCLCLNT):"selected",1:"all")_" CLINICS, ")
W !,$$CENTER($S(APCLIBEN=1:"INDIAN/ALASKA NATIVES ONLY",APCLIBEN'=1:"all BENEFICIARIES"))
;
W !,$$CENTER("Visit Dates: "_APCLSDD_" to "_APCLEDD)
Q
;
DTLHDR ; Detail header
D:APCLPG HEAD
D SELHDR
W !,?62,"B/P",?72,"MEAN"
W !,"PATIENT NAME",?17,"HRN #",?25,"AGE",?30,"SEX",?35,"COMMUNITY",?47,"CLINIC",?61,"COUNT",?73,"B/P"
W !,APCL80
Q
;
SMYHDR ; Summary header
D:APCLPG HEAD
D SELHDR
W !,$$CENTER("IN CONTROL --> MEAN SYSTOLIC < 140 MEAN DIASTOLIC < 90")
W !!,?21,"B/P MEAN",?40,"# OF PATIENTS",?64,"% OF PATIENTS"
W !,?5,"COMMUNITY",?20,"IN",?28,"OUT",?39,"IN",?52,"OUT",?63,"IN",?76,"OUT"
W !,APCL80
Q
;
CENTER(APCLX,APCLY) ;
S APCLY=$G(APCLY,80)
Q $J("",APCLY-$L(APCLX)/2)_APCLX
;
DONE D DONE^APCLOSUT
K ^XTMP("APCLBP",APCLJOB,APCLBTH),APCLJOB,APCLBTH
Q
APCLBPP ; IHS/CMI/LAB - print dx by age ;
+1 ;;2.0;IHS PCC SUITE;**10,15**;MAY 14, 2009;Build 11
START ;
+1 SET APCL80=""
SET $PIECE(APCL80,"-",80)="-"
+2 SET (APCLPG,APCLSEXP)=0
SET APCLSDD=9999999-APCLSD
SET APCLEDD=9999999-APCLED
+3 SET Y=APCLSDD
DO DD^%DT
SET APCLSDD=Y
SET Y=APCLEDD
DO DD^%DT
SET APCLEDD=Y
+4 KILL APCLQUIT
+5 Begin DoDot:1
+6 IF APCLPTOT=0
DO HEAD
DO SELHDR
WRITE !,"NO PATIENT DATA TO REPORT",!
QUIT
+7 IF APCLRTYP="D"
DO DTLHDR
Begin DoDot:2
+8 SET APCLSRT=""
FOR
SET APCLSRT=$ORDER(^XTMP("APCLBP",APCLJOB,APCLBTH,"PATS",APCLSRT))
IF APCLSRT=""!($DATA(APCLQUIT))
QUIT
DO PAT
+9 IF $DATA(APCLQUIT)
QUIT
+10 IF $Y>(IOSL-16)
DO DTLHDR
+11 WRITE !!,"TOTAL NUMBER OF PATIENTS: ",APCLPTOT
End DoDot:2
QUIT
+12 DO SMYHDR
+13 SET APCLSRT=0
FOR
SET APCLSRT=$ORDER(^XTMP("APCLBP",APCLJOB,APCLBTH,"STATS",APCLSRT))
IF APCLSRT=""!($DATA(APCLQUIT))
QUIT
IF $DATA(^XTMP("APCLBP",APCLJOB,APCLBTH,"STATS",APCLSRT))>1
DO STATS
+14 IF $DATA(APCLQUIT)
QUIT
+15 IF $Y>(IOSL-16)
DO SMYHDR
+16 SET APCLSRT=0
DO STATS
End DoDot:1
+17 DO DONE
+18 QUIT
PAT ;
+1 SET DFN=0
FOR
SET DFN=$ORDER(^XTMP("APCLBP",APCLJOB,APCLBTH,"PATS",APCLSRT,DFN))
IF DFN'=+DFN!($DATA(APCLQUIT))
QUIT
SET APCLX=^XTMP("APCLBP",APCLJOB,APCLBTH,"PATS",APCLSRT,DFN)
Begin DoDot:1
+2 IF $Y>(IOSL-4)
DO DTLHDR
IF $DATA(APCLQUIT)
QUIT
+3 WRITE !
IF APCLIDEN#10=0
WRITE $EXTRACT($PIECE(APCLX,U),1,15)
IF APCLIDEN<10
WRITE ?17,$PIECE(APCLX,U,2)
+4 SET APCLCMTY=$PIECE(APCLX,U,5)
SET APCLCMTY=$SELECT(APCLCMTY?1A.E:$EXTRACT(APCLCMTY,1,10),APCLCMTY=0:"TOTAL",1:$PIECE(APCLCMTY,"~",2))
+5 WRITE ?25,$JUSTIFY($PIECE(APCLX,U,3),3),?30,$PIECE(APCLX,U,4),?35,APCLCMTY,?47,$EXTRACT($PIECE(APCLX,U,6),1,10),?61,$JUSTIFY($FNUMBER($PIECE(APCLX,U,7),","),5),?71,$PIECE(APCLX,U,8)
End DoDot:1
+6 QUIT
+7 ;
+8 ; APCLBPTI - B/P type index: 1 = Systolic, 2 = Diastolic
STATS ;
+1 IF $Y>(IOSL-4)
DO SMYHDR
IF $DATA(APCLQUIT)
QUIT
+2 SET APCLX=^XTMP("APCLBP",APCLJOB,APCLBTH,"STATS",APCLSRT)
+3 SET APCLTPT=$PIECE(APCLX,U,1)
SET APCLTOPT=$PIECE(APCLX,U,2)
SET APCLBPC=$PIECE(APCLX,U,3)
+4 FOR APCLBPTI=1,2
Begin DoDot:1
+5 SET APCLBPX=^XTMP("APCLBP",APCLJOB,APCLBTH,"STATS",APCLSRT,APCLBPTI)
+6 SET APCLTBP=$PIECE(APCLBPX,U,1)
SET APCLTOP=$PIECE(APCLBPX,U,2)
SET APCLTOBC=$PIECE(APCLBPX,U,3)
SET APCLTOBP=$PIECE(APCLBPX,U,4)
+7 WRITE !
IF APCLBPTI=1
WRITE ?5,$SELECT(APCLSRT?1A.E:$EXTRACT(APCLSRT,1,10),APCLSRT=0:"TOTAL",1:$PIECE(APCLSRT,"~",2))
IF APCLBPC-APCLTOBC>0
WRITE ?19,$JUSTIFY(APCLTBP-APCLTOBP\(APCLBPC-APCLTOBC),3)
+8 IF APCLTOBC
WRITE ?28,$JUSTIFY(APCLTOBP\APCLTOBC,3)
+9 IF APCLBPTI=1
WRITE ?35,$JUSTIFY($FNUMBER(APCLTPT-APCLTOPT,","),6),?49,$JUSTIFY($FNUMBER(APCLTOPT,","),6)
SET APCLPCT=APCLTPT-APCLTOPT/APCLTPT*100\1
WRITE ?62,$JUSTIFY(APCLPCT,3),?76,$JUSTIFY(100-APCLPCT,3)
+10 IF APCLBPTI=2
WRITE !
End DoDot:1
+11 QUIT
+12 ;
HEAD ;
+1 IF APCLPG
IF $EXTRACT(IOST)="C"
IF IO=IO(0)
WRITE !
SET DIR(0)="EO"
DO ^DIR
KILL DIR
IF Y=0!(Y="^")!($DATA(DTOUT))
SET APCLQUIT=""
QUIT
+2 QUIT
+3 ;
SELHDR ; Header showing what was selected
+1 IF $DATA(IOF)
WRITE @IOF
SET APCLPG=APCLPG+1
+2 WRITE !!,$PIECE(^VA(200,DUZ,0),"^",2),$$CENTER($PIECE(^DIC(4,DUZ(2),0),"^"),78),?71,"Page ",APCLPG,!
+3 WRITE ?22,"BLOOD PRESSURE OUT OF CONTROL REPORT"
+4 WRITE !,$$CENTER($SELECT(APCLRTYP="D":"LIST OF BLOOD PRESSURE OUT OF CONTROL PATIENTS",1:"BLOOD PRESSURE IN/OUT OF CONTROL STATISTICS"))
+5 IF APCLSEAT'=""
WRITE !,$$CENTER("Search Template of Patients: "_$PIECE(^DIBT(APCLSEAT,0),U)),!
+6 WRITE !,$$CENTER("Report includes: "_$SELECT('$DATA(APCLAGER):"ALL AGES",1:"AGES: "_APCLAGER)_", "_$SELECT(APCLSEX="B":"MALES/FEMALES/UNKNOWN",APCLSEX="F":"FEMALES",APCLSEX="U":"UNKNOWN GENDER",APCLSEX="M":"MALES",1:"ALL GENDERS")_", ")
+7 WRITE !,$$CENTER($SELECT($DATA(APCLCOMM):"selected",1:"ALL")_" COMMUNITIES, "_$SELECT($DATA(APCLCLNT):"selected",1:"all")_" CLINICS, ")
+8 WRITE !,$$CENTER($SELECT(APCLIBEN=1:"INDIAN/ALASKA NATIVES ONLY",APCLIBEN'=1:"all BENEFICIARIES"))
+9 ;
+10 WRITE !,$$CENTER("Visit Dates: "_APCLSDD_" to "_APCLEDD)
+11 QUIT
+12 ;
DTLHDR ; Detail header
+1 IF APCLPG
DO HEAD
+2 DO SELHDR
+3 WRITE !,?62,"B/P",?72,"MEAN"
+4 WRITE !,"PATIENT NAME",?17,"HRN #",?25,"AGE",?30,"SEX",?35,"COMMUNITY",?47,"CLINIC",?61,"COUNT",?73,"B/P"
+5 WRITE !,APCL80
+6 QUIT
+7 ;
SMYHDR ; Summary header
+1 IF APCLPG
DO HEAD
+2 DO SELHDR
+3 WRITE !,$$CENTER("IN CONTROL --> MEAN SYSTOLIC < 140 MEAN DIASTOLIC < 90")
+4 WRITE !!,?21,"B/P MEAN",?40,"# OF PATIENTS",?64,"% OF PATIENTS"
+5 WRITE !,?5,"COMMUNITY",?20,"IN",?28,"OUT",?39,"IN",?52,"OUT",?63,"IN",?76,"OUT"
+6 WRITE !,APCL80
+7 QUIT
+8 ;
CENTER(APCLX,APCLY) ;
+1 SET APCLY=$GET(APCLY,80)
+2 QUIT $JUSTIFY("",APCLY-$LENGTH(APCLX)/2)_APCLX
+3 ;
DONE DO DONE^APCLOSUT
+1 KILL ^XTMP("APCLBP",APCLJOB,APCLBTH),APCLJOB,APCLBTH
+2 QUIT
