APCLBP ; IHS/CMI/LAB - AGE BUCKET/DIAGNOSIS REPORT ;
;;2.0;IHS PCC SUITE;**10,15**;MAY 14, 2009;Build 11
;
; If APCLREP (repeat) = 1 then the last tag executed in APCLTAG is
; repeated.
; If DIRUT = 1 execution starts at the tag in APCLTAG that is the one
; before the last one executed.
START ;
S APCLERR=0,APCLREP=0,APCLTAGS="ASKPT\CMMNTS\CLINIC\DATERNG\AGE\SEX\INDBEN\RTYPE\ZIS"
W !!?15,"***** BLOOD PRESSURE OUT OF CONTROL REPORT *****",!!
D DESCR
F APCLI=1:1:$L(APCLTAGS,"\") D @($P(APCLTAGS,"\",APCLI)) Q:APCLERR Q:$G(Y)="^^" S:APCLREP APCLREP=0,APCLI=APCLI-1 I $D(DIRUT) Q:APCLI=1 S APCLI=APCLI-2
D EXIT
Q
;
; Ask to search all patients or use a template
ASKPT ;
S APCLTYPE=""
S APCLSEAT=""
K DIR,X,Y
S DIR(0)="S^S:Search Template of Patients;P:Search All Patients"
S DIR("A")=" Select List " D ^DIR K DIR S:$D(DUOUT) DIRUT=1
S APCLTYPE=Y
D:APCLTYPE="S" TEMPLATE
Q
;
; Template was selected
TEMPLATE ;
;
W ! S DIC("S")="I $P(^(0),U,4)=9000001" S DIC="^DIBT(",DIC("A")="Enter Visit SEARCH TEMPLATE name: ",DIC(0)="AEMQ" D ^DIC K DIC,DA,DR,DICR
S:$D(DUOUT)!$D(DIRUT) APCLREP=1 S:Y<0 APCLREP=1
; If APCLREP = 1 the program will return to ASKPT (the last tag executed in the main for loop)
I APCLREP K DIRUT,APCLTYPE Q
S APCLSEAT=+Y
Q
;
; Ask for communities
CMMNTS ;
K APCLCOMM
S DIR(0)="S^O:One particular Community;A:All Communities;S:Selected Set of Communities (Taxonomy)",DIR("A")="List patients who live in",DIR("B")="O" K DA D ^DIR K DIR
Q:$D(DIRUT)
I Y="A" W !!,"Patients from all communities will be included in the report.",! Q
I Y="O" D S:'$D(APCLCOMM) APCLREP=1 Q
.S DIC="^AUTTCOM(",DIC(0)="AEMQ",DIC("A")="Which COMMUNITY: " D ^DIC K DIC
.Q:Y=-1
.S APCLCOMM($P(^AUTTCOM(+Y,0),U))=""
S X="COMMUNITY",DIC="^AMQQ(5,",DIC(0)="FM",DIC("S")="I $P(^(0),U,14)" D ^DIC K DIC,DA I Y=-1 W "OOPS - QMAN NOT CURRENT - QUITTING" S APCLERR=1 Q
D PEP^AMQQGTX0(+Y,"APCLCOMM(")
I '$D(APCLCOMM) S APCLREP=1 Q
I $D(APCLCOMM("*")) K APCLCOMM
Q
;
; Ask for Clinic
CLINIC ;
K APCLCLNT
W ! S DIR(0)="Y",DIR("A")="Include visits to ALL clinics",DIR("B")="Yes" D ^DIR K DIR S:$D(DUOUT) DIRUT=1
Q:$D(DIRUT)
Q:Y=1
S X="CLINIC",DIC="^AMQQ(5,",DIC(0)="FM",DIC("S")="I $P(^(0),U,14)" D ^DIC K DIC,DA I Y=-1 S APCLERR=1 W "OOPS - QMAN NOT CURRENT - QUITTING" Q
D PEP^AMQQGTX0(+Y,"APCLCLNT(")
I '$D(APCLCLNT) S APCLREP=1 Q
I $D(APCLCLNT("*")) K APCLCLNT
Q
;
; Ask for date range
DATERNG ;
BD ; Ask starting date
I $D(DIRUT) S APCLI=APCLI-3 K DIRUT Q ; temporary line
S APCLSD=0,APCLED=9999999
W ! S DIR(0)="D^:DT:EP",DIR("A")="Enter beginning Visit Date" D ^DIR K DIR S:$D(DUOUT) DIRUT=1
Q:$D(DIRUT)
S APCLBD=Y,APCLSD=9999999-Y
D ED
Q
;
ED ; ask ending date
W ! S DIR(0)="DA^"_APCLBD_":DT:EP",DIR("A")="Enter ending Visit Date: " S Y=APCLBD D DD^%DT S Y="" D ^DIR K DIR S:$D(DUOUT) DIRUT=1
S:$D(DUOUT)!$D(DIRUT) APCLREP=1 S:Y<0 APCLREP=1
; If APCLREP = 1 the program will return to BD (the last tag executed in the main for loop)
I APCLREP K DIRUT,APCLTYPE Q
S APCLED=9999999-Y
Q
;
AGE ;
W !
K APCLAGER
S DIR(0)="FO^1:7",DIR("A")="Enter a Range of Ages (e.g. 5-12) [HIT RETURN TO INCLUDE ALL RANGES]" D ^DIR K DIR S:$D(DUOUT) DIRUT=1
I Y="" W !!,"No age range entered. All ages will be included." K DIRUT Q
Q:$D(DIRUT)
I Y'?1.3N1"-"1.3N W !!,$C(7),$C(7),"Enter an age range in the format nnn-nnn. E.g. 2-5, 12-74, 5-20." S APCLREP=1 Q
I $P(Y,"-")<2 W !,$C(7),"Cannot run for patients under 2." S APCLREP=1 Q
;I $P(Y,"-",2)>74 W !,$C(7),"Cannot run for patients over 74." S APCLREP=1 Q
S APCLAGER=Y
Q
;
SEX ;
S DIR(0)="S^M:Males;F:Females;U:Unknown Gender;B:ALL Genders",DIR("A")="Report should include",DIR("B")="B" D ^DIR K DIR S:$D(DUOUT) DIRUT=1
S APCLSEX=Y
Q
;
INDBEN ;
W !
S DIR(0)="Y",DIR("A")="Do you wish to include ONLY Indian/Alaska Native Beneficiaries",DIR("B")="N" D ^DIR K DIR S:$D(DUOUT) DIRUT=1
S APCLIBEN=Y
Q
;
; Ask if suppressing identifying information
IDENT ;
S DIR(0)="S^P:Patient Name;C:Chart #;B:Both;N:Neither",DIR("A")="Do you wish to suppress patient identifying data",DIR("B")="N" D ^DIR K DIR S:$D(DUOUT) DIRUT=1
S:$D(DUOUT)!$D(DIRUT) APCLREP=1 S:Y<0 APCLREP=1
; If APCLREP = 1 the program will return to RTYPE (the last tag executed in the main for loop)
I APCLREP K DIRUT,APCLTYPE Q
S APCLIDEN=$S(Y="P":1,Y="C":10,Y="B":11,1:0)
Q
;
; Ask if Detail or Summary type report
RTYPE ;
S DIR(0)="S^D:Detail;S:Summary;C:Cohort/Template Save",DIR("A")="Report type should be",DIR("B")="D" D ^DIR K DIR S:$D(DUOUT) DIRUT=1
S APCLRTYP=Y
Q:APCLRTYP="S"!$D(DIRUT)
I APCLRTYP="D" D SORT Q
; Create a cohort/template
D ^APCLSTMP
I X="^^" S Y="^^" Q
S:$D(DUOUT)!$D(DIRUT) APCLREP=1 S:$G(Y)<0 APCLREP=1
K:APCLREP DIRUT
Q
;
SORT ;
S DIR(0)="S^P:Patient Name;A:Age of Patient",DIR("A")="Sort the report by",DIR("B")="P" D ^DIR K DIR S:$D(DUOUT) DIRUT=1
S:$D(DUOUT)!$D(DIRUT) APCLREP=1 S:Y<0 APCLREP=1
; If APCLREP = 1 the program will return to RTYPE (the last tag executed in the main for loop)
I APCLREP K DIRUT,APCLTYPE Q
S APCLSORT=Y
W ! D IDENT
Q
;
DESCR ;
W ?26,"LIST OF BLOOD PRESSURE OUT OF CONTROL PATIENTS"
W !!,"This report will produce a listing of all patients for the specified age, sex,"
W !,"communities, clinic and time period, who are considered out of control based on",!,"their mean Systolic or Diastolic blood pressure .",!
W !,"Out of Control is defined as greater than or equal to 140/90."
Q
;
ZIS ;
DEMO ;
D DEMOCHK^APCLUTL(.APCLDEMO)
I APCLDEMO=-1 G RTYPE
S XBRC="^APCLBP1",XBNS="APCL",XBRX=""
S XBRP=$S(APCLRTYP'="C":"^APCLBPP",1:"")
D ^XBDBQUE
Q
;
EXIT ;
K APCL80,APCLA,APCLAGE,APCLAGER,APCLBD,APCLBHGH,APCLBMI,APCLBPC,APCLBPTY,APCLBPX,APCLBTH,APCLBTYP,APCLCBC,APCLCHT,APCLCLAS,APCLCLIN,APCLCLNC,APCLCMTS,APCLCMTY,APCLCOMM,APCLCPT,APCLCTB,APCLDT,APCLDTL,APCLED
K APCLEDD,APCLER,APCLERR,APCLI,APCLIBEN,APCLIDEN,APCLJOB,APCLLENG,APCLMDBP,APCLMGI,APCLMHT,APCLMIEN,APCLMSBP,APCLMWT,APCLNAME,APCLOCTL,APCLPCT,APCLPG,APCLPTOT,APCLQUIT,APCLREF,APCLREP,APCLROHT,APCLROWT,APCLRPT
K APCLRTYP,APCLSD,APCLSDD,APCLSEAT,APCLSEX,APCLSEXP,APCLSORT,APCLSRT,APCLTAGS,APCLTBP,APCLTDBP,APCLTOBC,APCLTOBP,APCLTOP,APCLTPOC,APCLTPT,APCLTSBP,APCLTYPE,APCLX,APCLY,DA,DFN,DIC,DIR,DIRUT,J,K,M,R,S,X,X1
K X2,XBNS,XBRC,XBRP,XBRX,Y
Q
APCLBP ; IHS/CMI/LAB - AGE BUCKET/DIAGNOSIS REPORT ;
+1 ;;2.0;IHS PCC SUITE;**10,15**;MAY 14, 2009;Build 11
+2 ;
+3 ; If APCLREP (repeat) = 1 then the last tag executed in APCLTAG is
+4 ; repeated.
+5 ; If DIRUT = 1 execution starts at the tag in APCLTAG that is the one
+6 ; before the last one executed.
START ;
+1 SET APCLERR=0
SET APCLREP=0
SET APCLTAGS="ASKPT\CMMNTS\CLINIC\DATERNG\AGE\SEX\INDBEN\RTYPE\ZIS"
+2 WRITE !!?15,"***** BLOOD PRESSURE OUT OF CONTROL REPORT *****",!!
+3 DO DESCR
+4 FOR APCLI=1:1:$LENGTH(APCLTAGS,"\")
DO @($PIECE(APCLTAGS,"\",APCLI))
IF APCLERR
QUIT
IF $GET(Y)="^^"
QUIT
IF APCLREP
SET APCLREP=0
SET APCLI=APCLI-1
IF $DATA(DIRUT)
IF APCLI=1
QUIT
SET APCLI=APCLI-2
+5 DO EXIT
+6 QUIT
+7 ;
+8 ; Ask to search all patients or use a template
ASKPT ;
+1 SET APCLTYPE=""
+2 SET APCLSEAT=""
+3 KILL DIR,X,Y
+4 SET DIR(0)="S^S:Search Template of Patients;P:Search All Patients"
+5 SET DIR("A")=" Select List "
DO ^DIR
KILL DIR
IF $DATA(DUOUT)
SET DIRUT=1
+6 SET APCLTYPE=Y
+7 IF APCLTYPE="S"
DO TEMPLATE
+8 QUIT
+9 ;
+10 ; Template was selected
TEMPLATE ;
+1 ;
+2 WRITE !
SET DIC("S")="I $P(^(0),U,4)=9000001"
SET DIC="^DIBT("
SET DIC("A")="Enter Visit SEARCH TEMPLATE name: "
SET DIC(0)="AEMQ"
DO ^DIC
KILL DIC,DA,DR,DICR
+3 IF $DATA(DUOUT)!$DATA(DIRUT)
SET APCLREP=1
IF Y<0
SET APCLREP=1
+4 ; If APCLREP = 1 the program will return to ASKPT (the last tag executed in the main for loop)
+5 IF APCLREP
KILL DIRUT,APCLTYPE
QUIT
+6 SET APCLSEAT=+Y
+7 QUIT
+8 ;
+9 ; Ask for communities
CMMNTS ;
+1 KILL APCLCOMM
+2 SET DIR(0)="S^O:One particular Community;A:All Communities;S:Selected Set of Communities (Taxonomy)"
SET DIR("A")="List patients who live in"
SET DIR("B")="O"
KILL DA
DO ^DIR
KILL DIR
+3 IF $DATA(DIRUT)
QUIT
+4 IF Y="A"
WRITE !!,"Patients from all communities will be included in the report.",!
QUIT
+5 IF Y="O"
Begin DoDot:1
+6 SET DIC="^AUTTCOM("
SET DIC(0)="AEMQ"
SET DIC("A")="Which COMMUNITY: "
DO ^DIC
KILL DIC
+7 IF Y=-1
QUIT
+8 SET APCLCOMM($PIECE(^AUTTCOM(+Y,0),U))=""
End DoDot:1
IF '$DATA(APCLCOMM)
SET APCLREP=1
QUIT
+9 SET X="COMMUNITY"
SET DIC="^AMQQ(5,"
SET DIC(0)="FM"
SET DIC("S")="I $P(^(0),U,14)"
DO ^DIC
KILL DIC,DA
IF Y=-1
WRITE "OOPS - QMAN NOT CURRENT - QUITTING"
SET APCLERR=1
QUIT
+10 DO PEP^AMQQGTX0(+Y,"APCLCOMM(")
+11 IF '$DATA(APCLCOMM)
SET APCLREP=1
QUIT
+12 IF $DATA(APCLCOMM("*"))
KILL APCLCOMM
+13 QUIT
+14 ;
+15 ; Ask for Clinic
CLINIC ;
+1 KILL APCLCLNT
+2 WRITE !
SET DIR(0)="Y"
SET DIR("A")="Include visits to ALL clinics"
SET DIR("B")="Yes"
DO ^DIR
KILL DIR
IF $DATA(DUOUT)
SET DIRUT=1
+3 IF $DATA(DIRUT)
QUIT
+4 IF Y=1
QUIT
+5 SET X="CLINIC"
SET DIC="^AMQQ(5,"
SET DIC(0)="FM"
SET DIC("S")="I $P(^(0),U,14)"
DO ^DIC
KILL DIC,DA
IF Y=-1
SET APCLERR=1
WRITE "OOPS - QMAN NOT CURRENT - QUITTING"
QUIT
+6 DO PEP^AMQQGTX0(+Y,"APCLCLNT(")
+7 IF '$DATA(APCLCLNT)
SET APCLREP=1
QUIT
+8 IF $DATA(APCLCLNT("*"))
KILL APCLCLNT
+9 QUIT
+10 ;
+11 ; Ask for date range
DATERNG ;
BD ; Ask starting date
+1 ; temporary line
IF $DATA(DIRUT)
SET APCLI=APCLI-3
KILL DIRUT
QUIT
+2 SET APCLSD=0
SET APCLED=9999999
+3 WRITE !
SET DIR(0)="D^:DT:EP"
SET DIR("A")="Enter beginning Visit Date"
DO ^DIR
KILL DIR
IF $DATA(DUOUT)
SET DIRUT=1
+4 IF $DATA(DIRUT)
QUIT
+5 SET APCLBD=Y
SET APCLSD=9999999-Y
+6 DO ED
+7 QUIT
+8 ;
ED ; ask ending date
+1 WRITE !
SET DIR(0)="DA^"_APCLBD_":DT:EP"
SET DIR("A")="Enter ending Visit Date: "
SET Y=APCLBD
DO DD^%DT
SET Y=""
DO ^DIR
KILL DIR
IF $DATA(DUOUT)
SET DIRUT=1
+2 IF $DATA(DUOUT)!$DATA(DIRUT)
SET APCLREP=1
IF Y<0
SET APCLREP=1
+3 ; If APCLREP = 1 the program will return to BD (the last tag executed in the main for loop)
+4 IF APCLREP
KILL DIRUT,APCLTYPE
QUIT
+5 SET APCLED=9999999-Y
+6 QUIT
+7 ;
AGE ;
+1 WRITE !
+2 KILL APCLAGER
+3 SET DIR(0)="FO^1:7"
SET DIR("A")="Enter a Range of Ages (e.g. 5-12) [HIT RETURN TO INCLUDE ALL RANGES]"
DO ^DIR
KILL DIR
IF $DATA(DUOUT)
SET DIRUT=1
+4 IF Y=""
WRITE !!,"No age range entered. All ages will be included."
KILL DIRUT
QUIT
+5 IF $DATA(DIRUT)
QUIT
+6 IF Y'?1.3N1"-"1.3N
WRITE !!,$CHAR(7),$CHAR(7),"Enter an age range in the format nnn-nnn. E.g. 2-5, 12-74, 5-20."
SET APCLREP=1
QUIT
+7 IF $PIECE(Y,"-")<2
WRITE !,$CHAR(7),"Cannot run for patients under 2."
SET APCLREP=1
QUIT
+8 ;I $P(Y,"-",2)>74 W !,$C(7),"Cannot run for patients over 74." S APCLREP=1 Q
+9 SET APCLAGER=Y
+10 QUIT
+11 ;
SEX ;
+1 SET DIR(0)="S^M:Males;F:Females;U:Unknown Gender;B:ALL Genders"
SET DIR("A")="Report should include"
SET DIR("B")="B"
DO ^DIR
KILL DIR
IF $DATA(DUOUT)
SET DIRUT=1
+2 SET APCLSEX=Y
+3 QUIT
+4 ;
INDBEN ;
+1 WRITE !
+2 SET DIR(0)="Y"
SET DIR("A")="Do you wish to include ONLY Indian/Alaska Native Beneficiaries"
SET DIR("B")="N"
DO ^DIR
KILL DIR
IF $DATA(DUOUT)
SET DIRUT=1
+3 SET APCLIBEN=Y
+4 QUIT
+5 ;
+6 ; Ask if suppressing identifying information
IDENT ;
+1 SET DIR(0)="S^P:Patient Name;C:Chart #;B:Both;N:Neither"
SET DIR("A")="Do you wish to suppress patient identifying data"
SET DIR("B")="N"
DO ^DIR
KILL DIR
IF $DATA(DUOUT)
SET DIRUT=1
+2 IF $DATA(DUOUT)!$DATA(DIRUT)
SET APCLREP=1
IF Y<0
SET APCLREP=1
+3 ; If APCLREP = 1 the program will return to RTYPE (the last tag executed in the main for loop)
+4 IF APCLREP
KILL DIRUT,APCLTYPE
QUIT
+5 SET APCLIDEN=$SELECT(Y="P":1,Y="C":10,Y="B":11,1:0)
+6 QUIT
+7 ;
+8 ; Ask if Detail or Summary type report
RTYPE ;
+1 SET DIR(0)="S^D:Detail;S:Summary;C:Cohort/Template Save"
SET DIR("A")="Report type should be"
SET DIR("B")="D"
DO ^DIR
KILL DIR
IF $DATA(DUOUT)
SET DIRUT=1
+2 SET APCLRTYP=Y
+3 IF APCLRTYP="S"!$DATA(DIRUT)
QUIT
+4 IF APCLRTYP="D"
DO SORT
QUIT
+5 ; Create a cohort/template
+6 DO ^APCLSTMP
+7 IF X="^^"
SET Y="^^"
QUIT
+8 IF $DATA(DUOUT)!$DATA(DIRUT)
SET APCLREP=1
IF $GET(Y)<0
SET APCLREP=1
+9 IF APCLREP
KILL DIRUT
+10 QUIT
+11 ;
SORT ;
+1 SET DIR(0)="S^P:Patient Name;A:Age of Patient"
SET DIR("A")="Sort the report by"
SET DIR("B")="P"
DO ^DIR
KILL DIR
IF $DATA(DUOUT)
SET DIRUT=1
+2 IF $DATA(DUOUT)!$DATA(DIRUT)
SET APCLREP=1
IF Y<0
SET APCLREP=1
+3 ; If APCLREP = 1 the program will return to RTYPE (the last tag executed in the main for loop)
+4 IF APCLREP
KILL DIRUT,APCLTYPE
QUIT
+5 SET APCLSORT=Y
+6 WRITE !
DO IDENT
+7 QUIT
+8 ;
DESCR ;
+1 WRITE ?26,"LIST OF BLOOD PRESSURE OUT OF CONTROL PATIENTS"
+2 WRITE !!,"This report will produce a listing of all patients for the specified age, sex,"
+3 WRITE !,"communities, clinic and time period, who are considered out of control based on",!,"their mean Systolic or Diastolic blood pressure .",!
+4 WRITE !,"Out of Control is defined as greater than or equal to 140/90."
+5 QUIT
+6 ;
ZIS ;
DEMO ;
+1 DO DEMOCHK^APCLUTL(.APCLDEMO)
+2 IF APCLDEMO=-1
GOTO RTYPE
+3 SET XBRC="^APCLBP1"
SET XBNS="APCL"
SET XBRX=""
+4 SET XBRP=$SELECT(APCLRTYP'="C":"^APCLBPP",1:"")
+5 DO ^XBDBQUE
+6 QUIT
+7 ;
EXIT ;
+1 KILL APCL80,APCLA,APCLAGE,APCLAGER,APCLBD,APCLBHGH,APCLBMI,APCLBPC,APCLBPTY,APCLBPX,APCLBTH,APCLBTYP,APCLCBC,APCLCHT,APCLCLAS,APCLCLIN,APCLCLNC,APCLCMTS,APCLCMTY,APCLCOMM,APCLCPT,APCLCTB,APCLDT,APCLDTL,APCLED
+2 KILL APCLEDD,APCLER,APCLERR,APCLI,APCLIBEN,APCLIDEN,APCLJOB,APCLLENG,APCLMDBP,APCLMGI,APCLMHT,APCLMIEN,APCLMSBP,APCLMWT,APCLNAME,APCLOCTL,APCLPCT,APCLPG,APCLPTOT,APCLQUIT,APCLREF,APCLREP,APCLROHT,APCLROWT,APCLRPT
+3 KILL APCLRTYP,APCLSD,APCLSDD,APCLSEAT,APCLSEX,APCLSEXP,APCLSORT,APCLSRT,APCLTAGS,APCLTBP,APCLTDBP,APCLTOBC,APCLTOBP,APCLTOP,APCLTPOC,APCLTPT,APCLTSBP,APCLTYPE,APCLX,APCLY,DA,DFN,DIC,DIR,DIRUT,J,K,M,R,S,X,X1
+4 KILL X2,XBNS,XBRC,XBRP,XBRX,Y
+5 QUIT
