BCHRU1.m

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       ;