BCHRP4 ; IHS/CMI/LAB - All visit report driver 26 Apr 2007 10:51 AM ;
;;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!!",!! K BCHSITE Q
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" 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" 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 ;IHS/CMI/LAB - added program screen
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 REG
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
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 PROG
S BCHREG=Y,BCHREGN=Y(0)
ZIS ;CALL TO XBDBQUE
S XBRP="PRINT^BCHRP4",XBRC="PROC^BCHRP4",XBRX="XIT^BCHRP4",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 ;
D EN^XBVK("BCH")
K ^TMP($J)
Q
;
INFORM ;
W:$D(IOF) @IOF
W !,"****** REPORT OF # OF CHR PCCs/PATIENTS BY TRIBE ******",!
W !,"This report will tally records and patients seen by Tribe",!
Q
;
;
PROC ;EP - called from xbdbque
VD ; Run by visit date
S X1=BCHBD,X2=-1 D C^%DTC S BCHSD=X
K BCHTOT K ^TMP($J)
S (BCHTOTR,BCHTOTP)=0
S BCHODAT=BCHSD_".9999" F S BCHODAT=$O(^BCHR("B",BCHODAT)) Q:BCHODAT=""!((BCHODAT\1)>BCHED) D V1
Q
;
V1 ;
S BCHR="" F S BCHR=$O(^BCHR("B",BCHODAT,BCHR)) Q:BCHR'=+BCHR I $D(^BCHR(BCHR,0)),$P(^(0),U,2)]"",$P(^(0),U,3)]"" S BCHR0=^BCHR(BCHR,0),DFN=$P(BCHR0,U,4) D PROC1
Q
PROC1 ;
S BCHPAT=$P(BCHR0,U,4)
S BCHNRPAT=$P($G(^BCHR(BCHR,11)),U,12)
I 'BCHPAT,'BCHNRPAT Q ;no patient
I BCHREG="R",BCHPAT="" Q
I BCHREG="N",BCHNRPAT="" Q
I BCHPAT,BCHNRPAT S BCHNRPAT=""
I BCHPAT Q:'$D(^DPT(BCHPAT,0))
S BCHPROG=$P(BCHR0,U,2)
I BCHPRG,BCHPRG'=BCHPROG Q ;not correct program
I BCHPAT S T=$$VAL^XBDIQ1(9000001,BCHPAT,1108)
I BCHNRPAT S T=$$VAL^XBDIQ1(90002.11,BCHNRPAT,.05)
I T="" S T="UNKNOWN TRIBE"
S $P(BCHTOT(T),U,1)=$P($G(BCHTOT(T)),U,1)+1,BCHTOTR=BCHTOTR+1
I BCHPAT D
.I $D(^TMP($J,"DFN",DFN)) Q ;already counted this patient
.S ^TMP($J,"DFN",DFN)="" S $P(BCHTOT(T),U,2)=$P($G(BCHTOT(T)),U,2)+1,BCHTOTP=BCHTOTP+1
I BCHNRPAT D
.Q:$D(^TMP($J,"NRDFN",BCHNRPAT))
.S ^TMP($J,"NRDFN",BCHNRPAT)="" S $P(BCHTOT(T),U,2)=$P($G(BCHTOT(T)),U,2)+1,BCHTOTP=BCHTOTP+1
Q
PRINT ;EP
S BCHPG=0 S BCHQUIT=0
I '$D(BCHTOT) D HEAD W !!,"NO DATA TO REPORT",!! Q
D HEAD
S BCHT="" F S BCHT=$O(BCHTOT(BCHT)) Q:BCHT=""!(BCHQUIT) D
.I $Y>(IOSL-4) D HEAD Q:BCHQUIT
.W !?3,BCHT,?50,$$C($P(BCHTOT(BCHT),U,1),0,8),?65,$$C($P(BCHTOT(BCHT),U,2),0,8)
.Q
I $Y>(IOSL-3) D HEAD
I BCHQUIT G DONE
W !!?3,"ALL TRIBES/TOTAL",?50,$$C(BCHTOTR,0,8),?65,$$C(BCHTOTP,0,8)
DONE ;
K BCHET
D DONE^BCHUTIL1
Q
C(X,X2,X3) ;
D COMMA^%DTC
Q $$STRIP^XLFSTR(X," ")
HEAD ;
I 'BCHPG G HEAD1
I $E(IOST)="C",IO=IO(0) W ! S DIR(0)="EO" D ^DIR K DIR I Y=0!(Y="^")!($D(DTOUT)) S BCHQUIT=1 Q
HEAD1 ; if terminal
W:$D(IOF) @IOF
HEAD2 ; if printer
S BCHPG=BCHPG+1
W !?13,"********** CONFIDENTIAL PATIENT INFORMATION **********"
W !,$P(^VA(200,DUZ,0),U,2),?33,$$FMTE^XLFDT(DT),?70,"Page ",BCHPG,!
W $$CTR^BCHRLU($$LOC^BCHRLU),!
S X="TALLY OF CHR PCCs AND PATIENTS BY TRIBE" W $$CTR^BCHRLU(X,80),!
S BCHPROGN=$S(BCHPRG:$P(^BCHTPROG(BCHPRG,0),U)_" ("_$P(^(0),U,5)_")",1:"ALL"),X=$L(BCHPROGN)+10
W ?((80-X)/2),"PROGRAM: ",BCHPROGN,!
S X=$L("PATIENTS: "_BCHREGN)
W ?((80-X)/2),"PATIENTS: ",BCHREGN,!
W ?17,"REPORT DATES: ",$$FMTE^XLFDT(BCHBD)," TO ",$$FMTE^XLFDT(BCHED),!
W !?50,"# CHR PCCs",?65,"# PATIENTS",!
W !,$TR($J(" ",80)," ","-")
Q
BCHRP4 ; IHS/CMI/LAB - All visit report driver 26 Apr 2007 10:51 AM ;
+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!!",!!
KILL BCHSITE
QUIT
+2 SET BCHJOB=$JOB
SET BCHBTH=$HOROLOG
+3 DO INFORM
GETDATES ;
BD ;get beginning date
+1 WRITE !
SET DIR(0)="D^:DT:EP"
SET DIR("A")="Enter beginning Date of Service"
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"
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 ;IHS/CMI/LAB - added program screen
+1 SET BCHPRG=""
+2 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
+3 IF $DATA(DIRUT)
GOTO BD
+4 IF Y=1
SET BCHPRG=""
GOTO REG
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
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 PROG
+4 SET BCHREG=Y
SET BCHREGN=Y(0)
ZIS ;CALL TO XBDBQUE
+1 SET XBRP="PRINT^BCHRP4"
SET XBRC="PROC^BCHRP4"
SET XBRX="XIT^BCHRP4"
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 DO EN^XBVK("BCH")
+2 KILL ^TMP($JOB)
+3 QUIT
+4 ;
INFORM ;
+1 IF $DATA(IOF)
WRITE @IOF
+2 WRITE !,"****** REPORT OF # OF CHR PCCs/PATIENTS BY TRIBE ******",!
+3 WRITE !,"This report will tally records and patients seen by Tribe",!
+4 QUIT
+5 ;
+6 ;
PROC ;EP - called from xbdbque
VD ; Run by visit date
+1 SET X1=BCHBD
SET X2=-1
DO C^%DTC
SET BCHSD=X
+2 KILL BCHTOT
KILL ^TMP($JOB)
+3 SET (BCHTOTR,BCHTOTP)=0
+4 SET BCHODAT=BCHSD_".9999"
FOR
SET BCHODAT=$ORDER(^BCHR("B",BCHODAT))
IF BCHODAT=""!((BCHODAT\1)>BCHED)
QUIT
DO V1
+5 QUIT
+6 ;
V1 ;
+1 SET BCHR=""
FOR
SET BCHR=$ORDER(^BCHR("B",BCHODAT,BCHR))
IF BCHR'=+BCHR
QUIT
IF $DATA(^BCHR(BCHR,0))
IF $PIECE(^(0),U,2)]""
IF $PIECE(^(0),U,3)]""
SET BCHR0=^BCHR(BCHR,0)
SET DFN=$PIECE(BCHR0,U,4)
DO PROC1
+2 QUIT
PROC1 ;
+1 SET BCHPAT=$PIECE(BCHR0,U,4)
+2 SET BCHNRPAT=$PIECE($GET(^BCHR(BCHR,11)),U,12)
+3 ;no patient
IF 'BCHPAT
IF 'BCHNRPAT
QUIT
+4 IF BCHREG="R"
IF BCHPAT=""
QUIT
+5 IF BCHREG="N"
IF BCHNRPAT=""
QUIT
+6 IF BCHPAT
IF BCHNRPAT
SET BCHNRPAT=""
+7 IF BCHPAT
IF '$DATA(^DPT(BCHPAT,0))
QUIT
+8 SET BCHPROG=$PIECE(BCHR0,U,2)
+9 ;not correct program
IF BCHPRG
IF BCHPRG'=BCHPROG
QUIT
+10 IF BCHPAT
SET T=$$VAL^XBDIQ1(9000001,BCHPAT,1108)
+11 IF BCHNRPAT
SET T=$$VAL^XBDIQ1(90002.11,BCHNRPAT,.05)
+12 IF T=""
SET T="UNKNOWN TRIBE"
+13 SET $PIECE(BCHTOT(T),U,1)=$PIECE($GET(BCHTOT(T)),U,1)+1
SET BCHTOTR=BCHTOTR+1
+14 IF BCHPAT
Begin DoDot:1
+15 ;already counted this patient
IF $DATA(^TMP($JOB,"DFN",DFN))
QUIT
+16 SET ^TMP($JOB,"DFN",DFN)=""
SET $PIECE(BCHTOT(T),U,2)=$PIECE($GET(BCHTOT(T)),U,2)+1
SET BCHTOTP=BCHTOTP+1
End DoDot:1
+17 IF BCHNRPAT
Begin DoDot:1
+18 IF $DATA(^TMP($JOB,"NRDFN",BCHNRPAT))
QUIT
+19 SET ^TMP($JOB,"NRDFN",BCHNRPAT)=""
SET $PIECE(BCHTOT(T),U,2)=$PIECE($GET(BCHTOT(T)),U,2)+1
SET BCHTOTP=BCHTOTP+1
End DoDot:1
+20 QUIT
PRINT ;EP
+1 SET BCHPG=0
SET BCHQUIT=0
+2 IF '$DATA(BCHTOT)
DO HEAD
WRITE !!,"NO DATA TO REPORT",!!
QUIT
+3 DO HEAD
+4 SET BCHT=""
FOR
SET BCHT=$ORDER(BCHTOT(BCHT))
IF BCHT=""!(BCHQUIT)
QUIT
Begin DoDot:1
+5 IF $Y>(IOSL-4)
DO HEAD
IF BCHQUIT
QUIT
+6 WRITE !?3,BCHT,?50,$$C($PIECE(BCHTOT(BCHT),U,1),0,8),?65,$$C($PIECE(BCHTOT(BCHT),U,2),0,8)
+7 QUIT
End DoDot:1
+8 IF $Y>(IOSL-3)
DO HEAD
+9 IF BCHQUIT
GOTO DONE
+10 WRITE !!?3,"ALL TRIBES/TOTAL",?50,$$C(BCHTOTR,0,8),?65,$$C(BCHTOTP,0,8)
DONE ;
+1 KILL BCHET
+2 DO DONE^BCHUTIL1
+3 QUIT
C(X,X2,X3) ;
+1 DO COMMA^%DTC
+2 QUIT $$STRIP^XLFSTR(X," ")
HEAD ;
+1 IF 'BCHPG
GOTO HEAD1
+2 IF $EXTRACT(IOST)="C"
IF IO=IO(0)
WRITE !
SET DIR(0)="EO"
DO ^DIR
KILL DIR
IF Y=0!(Y="^")!($DATA(DTOUT))
SET BCHQUIT=1
QUIT
HEAD1 ; if terminal
+1 IF $DATA(IOF)
WRITE @IOF
HEAD2 ; if printer
+1 SET BCHPG=BCHPG+1
+2 WRITE !?13,"********** CONFIDENTIAL PATIENT INFORMATION **********"
+3 WRITE !,$PIECE(^VA(200,DUZ,0),U,2),?33,$$FMTE^XLFDT(DT),?70,"Page ",BCHPG,!
+4 WRITE $$CTR^BCHRLU($$LOC^BCHRLU),!
+5 SET X="TALLY OF CHR PCCs AND PATIENTS BY TRIBE"
WRITE $$CTR^BCHRLU(X,80),!
+6 SET BCHPROGN=$SELECT(BCHPRG:$PIECE(^BCHTPROG(BCHPRG,0),U)_" ("_$PIECE(^(0),U,5)_")",1:"ALL")
SET X=$LENGTH(BCHPROGN)+10
+7 WRITE ?((80-X)/2),"PROGRAM: ",BCHPROGN,!
+8 SET X=$LENGTH("PATIENTS: "_BCHREGN)
+9 WRITE ?((80-X)/2),"PATIENTS: ",BCHREGN,!
+10 WRITE ?17,"REPORT DATES: ",$$FMTE^XLFDT(BCHBD)," TO ",$$FMTE^XLFDT(BCHED),!
+11 WRITE !?50,"# CHR PCCs",?65,"# PATIENTS",!
+12 WRITE !,$TRANSLATE($JUSTIFY(" ",80)," ","-")
+13 QUIT
