- 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
