BCHRU1 ; IHS/CMI/LAB - CHR Report 1 ;
;;2.0;IHS RPMS CHR SYSTEM;;OCT 23, 2012;Build 27
;
START ;
I '$G(DUZ(2)) W $C(7),$C(7),!!,"SITE NOT SET IN DUZ(2) - NOTIFY SITE MANAGER!!",!! Q
I '$G(BCHRPT) W !,$C(7),$C(7),"REPORT NUMBER MISSING" Q
D @BCHRPT
S BCHJOB=$J,BCHBTH=$H
D INFORM
GETDATES ;
BD ;get beginning date
W ! S DIR(0)="D^:DT:EP",DIR("A")="Enter BEGINNING Date of Service for Report" D ^DIR K DIR S:$D(DUOUT) DIRUT=1
I $D(DIRUT) G XIT
S BCHBD=Y
ED ;get ending date
W ! S DIR(0)="D^"_BCHBD_":DT:EP",DIR("A")="Enter ENDING Date of Service for Report" S Y=BCHBD D DD^%DT S DIR("B")=Y,Y="" D ^DIR K DIR S:$D(DUOUT) DIRUT=1
I $D(DIRUT) G BD
S BCHED=Y
S X1=BCHBD,X2=-1 D C^%DTC S BCHSD=X
;
PROG ;
W !
S BCHPRG=""
S DIR(0)="Y",DIR("A")="Include data from ALL CHR Programs",DIR("B")="N",DIR("?")="If you wish to include visits from ALL programs answer Yes. If you wish to tabulate for only one program enter NO." D ^DIR K DIR
G:$D(DIRUT) BD
I Y=1 S BCHPRG="" G CHRT
PROG1 ;enter program
K X,DIC,DA,DD,DR,Y S DIC("A")="Which CHR Program: ",DIC="^BCHTPROG(",DIC(0)="AEMQ" D ^DIC K DIC,DA G:Y<0 PROG
S BCHPRG=+Y
CHRT ;
W !
K BCHPROVT
S DIR(0)="S^O:One CHR;A:All CHRs",DIR("A")="Include Data for",DIR("B")="A" KILL DA D ^DIR KILL DIR
I $D(DIRUT) G PROG
S BCHPROVT=Y
I BCHPROVT="A" G REG
CHR1 ;
K DIC
S DIC=200,DIC(0)="AEMQ",DIC("A")="Enter the CHR: " D ^DIC
I Y=-1 G CHRT
S BCHCHR1=+Y
REG ;
S BCHREG="",BCHREGN=""
S DIR(0)="S^R:Registered Patients;N:Non-Registered Patients;B:Both Registered and Non-Registered Patients",DIR("A")="Include which Patients",DIR("B")="B" KILL DA D ^DIR KILL DIR
I $D(DIRUT) G CHRT
S BCHREG=Y,BCHREGN=Y(0)
SUB ;
;W !
S BCHSUB="",BCHSUB3=""
;I BCHRPT=4 S BCHSUB=0 G ZIS
;I BCHRPT'=3 S DIR(0)="Y",DIR("A")="Do you wish to subtotal by "_BCHSUBT,DIR("B")="N" KILL DA D ^DIR KILL DIR
;S DIR(0)="S^H:HEALTH PROBLEM;S:SERVICE CODE;N:NO SUBTOTALLING",DIR("A")="Sub total by",DIR("B")="N" KILL DA D ^DIR KILL DIR
;I $D(DIRUT) G REG
;S BCHSUB3=Y,Y=$S(BCHSUB3="N":0,1:1),BCHSUBT=$S(BCHSUB3="H":"HEALTH PROBLEM",BCHSUB3="S":"SERVICE CODE",1:"")
S BCHSUB="N"
ZIS ;CALL TO XBDBQUE
S XBRP="^BCHRU1P",XBRC="^BCHRU11",XBRX="XIT^BCHRU1",XBNS="BCH"
D ^XBDBQUE
D XIT
Q
ERR W $C(7),$C(7),!,"Must be a valid date and be Today or earlier. Time not allowed!" Q
XIT ;
K BCHPRG,BCHTOTC,BCHTOTS,BCHTOTA,BCHTOTT,BCHHA,BCHCA,BCHCC,BCHCS,BCHCT,BCHQUIT,BCHJOB,BCHBTH,BCHBT,BCHET,BCHBD,BCHED,BCHBDD,BCHEDD,BCHSD,BCHODAT,BCHPROG,BCHX,BCHC,BCHPROB,BCHPROBN,BCHR,BCHR0,BCHPG,BCHDT,BCHRPT,BCHCH
Q
;
X1 ;
S BCHCH="HEALTH PROBLEM",BCHSUBT="SERVICE CODE"
Q
X2 ;
S BCHCH="SERVICE",BCHSUBT="HEALTH PROBLEM"
Q
1 ;
S BCHCH="CHR",BCHSUBT="HEALTH PROBLEM"
Q
2 ;
S BCHCH="PATIENT AGE",BCHSUBT="HEALTH PROBLEM"
Q
3 ;
S BCHCH="GENDER",BCHSUBT="HEALTH PROBLEM"
Q
4 ;
S BCHCH="TRIBE",BCHSUBT="HEALTH PROBLEM"
Q
5 ;
S BCHCH="PROGRAM",BCHSUBT="HEALTH PROBLEM"
Q
INFORM ;
W:$D(IOF) @IOF
W !?20,"********** UNDUPLICATED PATIENT REPORT NO. ",BCHRPT," **********"
W !!,"This report will present an unduplicated count of patients seen by ",BCHCH,".",!!
Q
;
;
BCHRU1 ; IHS/CMI/LAB - CHR Report 1 ;
+1 ;;2.0;IHS RPMS CHR SYSTEM;;OCT 23, 2012;Build 27
+2 ;
START ;
+1 IF '$GET(DUZ(2))
WRITE $CHAR(7),$CHAR(7),!!,"SITE NOT SET IN DUZ(2) - NOTIFY SITE MANAGER!!",!!
QUIT
+2 IF '$GET(BCHRPT)
WRITE !,$CHAR(7),$CHAR(7),"REPORT NUMBER MISSING"
QUIT
+3 DO @BCHRPT
+4 SET BCHJOB=$JOB
SET BCHBTH=$HOROLOG
+5 DO INFORM
GETDATES ;
BD ;get beginning date
+1 WRITE !
SET DIR(0)="D^:DT:EP"
SET DIR("A")="Enter BEGINNING Date of Service for Report"
DO ^DIR
KILL DIR
IF $DATA(DUOUT)
SET DIRUT=1
+2 IF $DATA(DIRUT)
GOTO XIT
+3 SET BCHBD=Y
ED ;get ending date
+1 WRITE !
SET DIR(0)="D^"_BCHBD_":DT:EP"
SET DIR("A")="Enter ENDING Date of Service for Report"
SET Y=BCHBD
DO DD^%DT
SET DIR("B")=Y
SET Y=""
DO ^DIR
KILL DIR
IF $DATA(DUOUT)
SET DIRUT=1
+2 IF $DATA(DIRUT)
GOTO BD
+3 SET BCHED=Y
+4 SET X1=BCHBD
SET X2=-1
DO C^%DTC
SET BCHSD=X
+5 ;
PROG ;
+1 WRITE !
+2 SET BCHPRG=""
+3 SET DIR(0)="Y"
SET DIR("A")="Include data from ALL CHR Programs"
SET DIR("B")="N"
SET DIR("?")="If you wish to include visits from ALL programs answer Yes. If you wish to tabulate for only one program enter NO."
DO ^DIR
KILL DIR
+4 IF $DATA(DIRUT)
GOTO BD
+5 IF Y=1
SET BCHPRG=""
GOTO CHRT
PROG1 ;enter program
+1 KILL X,DIC,DA,DD,DR,Y
SET DIC("A")="Which CHR Program: "
SET DIC="^BCHTPROG("
SET DIC(0)="AEMQ"
DO ^DIC
KILL DIC,DA
IF Y<0
GOTO PROG
+2 SET BCHPRG=+Y
CHRT ;
+1 WRITE !
+2 KILL BCHPROVT
+3 SET DIR(0)="S^O:One CHR;A:All CHRs"
SET DIR("A")="Include Data for"
SET DIR("B")="A"
KILL DA
DO ^DIR
KILL DIR
+4 IF $DATA(DIRUT)
GOTO PROG
+5 SET BCHPROVT=Y
+6 IF BCHPROVT="A"
GOTO REG
CHR1 ;
+1 KILL DIC
+2 SET DIC=200
SET DIC(0)="AEMQ"
SET DIC("A")="Enter the CHR: "
DO ^DIC
+3 IF Y=-1
GOTO CHRT
+4 SET BCHCHR1=+Y
REG ;
+1 SET BCHREG=""
SET BCHREGN=""
+2 SET DIR(0)="S^R:Registered Patients;N:Non-Registered Patients;B:Both Registered and Non-Registered Patients"
SET DIR("A")="Include which Patients"
SET DIR("B")="B"
KILL DA
DO ^DIR
KILL DIR
+3 IF $DATA(DIRUT)
GOTO CHRT
+4 SET BCHREG=Y
SET BCHREGN=Y(0)
SUB ;
+1 ;W !
+2 SET BCHSUB=""
SET BCHSUB3=""
+3 ;I BCHRPT=4 S BCHSUB=0 G ZIS
+4 ;I BCHRPT'=3 S DIR(0)="Y",DIR("A")="Do you wish to subtotal by "_BCHSUBT,DIR("B")="N" KILL DA D ^DIR KILL DIR
+5 ;S DIR(0)="S^H:HEALTH PROBLEM;S:SERVICE CODE;N:NO SUBTOTALLING",DIR("A")="Sub total by",DIR("B")="N" KILL DA D ^DIR KILL DIR
+6 ;I $D(DIRUT) G REG
+7 ;S BCHSUB3=Y,Y=$S(BCHSUB3="N":0,1:1),BCHSUBT=$S(BCHSUB3="H":"HEALTH PROBLEM",BCHSUB3="S":"SERVICE CODE",1:"")
+8 SET BCHSUB="N"
ZIS ;CALL TO XBDBQUE
+1 SET XBRP="^BCHRU1P"
SET XBRC="^BCHRU11"
SET XBRX="XIT^BCHRU1"
SET XBNS="BCH"
+2 DO ^XBDBQUE
+3 DO XIT
+4 QUIT
ERR WRITE $CHAR(7),$CHAR(7),!,"Must be a valid date and be Today or earlier. Time not allowed!"
QUIT
XIT ;
+1 KILL BCHPRG,BCHTOTC,BCHTOTS,BCHTOTA,BCHTOTT,BCHHA,BCHCA,BCHCC,BCHCS,BCHCT,BCHQUIT,BCHJOB,BCHBTH,BCHBT,BCHET,BCHBD,BCHED,BCHBDD,BCHEDD,BCHSD,BCHODAT,BCHPROG,BCHX,BCHC,BCHPROB,BCHPROBN,BCHR,BCHR0,BCHPG,BCHDT,BCHRPT,BCHCH
+2 QUIT
+3 ;
X1 ;
+1 SET BCHCH="HEALTH PROBLEM"
SET BCHSUBT="SERVICE CODE"
+2 QUIT
X2 ;
+1 SET BCHCH="SERVICE"
SET BCHSUBT="HEALTH PROBLEM"
+2 QUIT
1 ;
+1 SET BCHCH="CHR"
SET BCHSUBT="HEALTH PROBLEM"
+2 QUIT
2 ;
+1 SET BCHCH="PATIENT AGE"
SET BCHSUBT="HEALTH PROBLEM"
+2 QUIT
3 ;
+1 SET BCHCH="GENDER"
SET BCHSUBT="HEALTH PROBLEM"
+2 QUIT
4 ;
+1 SET BCHCH="TRIBE"
SET BCHSUBT="HEALTH PROBLEM"
+2 QUIT
5 ;
+1 SET BCHCH="PROGRAM"
SET BCHSUBT="HEALTH PROBLEM"
+2 QUIT
INFORM ;
+1 IF $DATA(IOF)
WRITE @IOF
+2 WRITE !?20,"********** UNDUPLICATED PATIENT REPORT NO. ",BCHRPT," **********"
+3 WRITE !!,"This report will present an unduplicated count of patients seen by ",BCHCH,".",!!
+4 QUIT
+5 ;
+6 ;
