BCHEXCP ; IHS/CMI/LAB - PRNT RECORD REVIEW ;
;;2.0;IHS RPMS CHR SYSTEM;;OCT 23, 2012;Build 27
;IHS/CMI/LAB - tmp to xtmp
;
;IHS/TUCSON/LAB - PATCH 3 CHANGED FILE NUMBERS AND FIELD NUMBER ON CHR DISPLAY
;Print export record check report.
;
START ;
S BCH80E="==============================================================================="
S BCH80D="-------------------------------------------------------------------------------"
S Y=BCHBD D DD^%DT S BCHBDD=Y S Y=BCHED D DD^%DT S BCHEDD=Y
S BCHPG=0 D HEAD I '$D(^XTMP("BCHEXC",BCHJOB,BCHBT)) W !,"No errors to report",! G DONE
S BCHR=0 K BCHQUIT
F S BCHR=$O(^XTMP("BCHEXC",BCHJOB,BCHBT,"ERRORS",BCHR)) Q:BCHR=""!($D(BCHQUIT)) D PROC
G:$D(BCHQUIT) DONE
I $Y>(IOSL-6) D HEAD G:$D(BCHQUIT) DONE
DONE ;
D DONE^BCHUTIL1
K ^XTMP("BCHEXC",BCHJOB,BCHBT)
Q
PROC ;
I $Y>(IOSL-5) D HEAD Q:$D(BCHQUIT)
S Y=$P(^BCHR(BCHR,0),U) D DD^%DT S BCHDATE=Y
S BCHNAME=$P(^BCHR(BCHR,0),U,4) I BCHNAME]"" S BCHNAME=$E($P(^DPT(BCHNAME,0),U),1,20)
I BCHNAME="" S BCHNAME=$P($G(^BCHR(BCHR,11)),U)
S BCHHRCN="" I $P(^BCHR(BCHR,0),U,4) S BCHHRCN=$S($D(^AUPNPAT($P(^BCHR(BCHR,0),U,4),41,DUZ(2),0)):$P(^(0),U,2),1:"<none>")
S BCHPROG=$E($$VAL^XBDIQ1(90002,BCHR,.02),1,5)
K ^UTILITY("DIQ1",$J)
K DIQ,DIC,DA,DR
S DIC="^BCHR(",DR=".03",DA=BCHR,DIQ(0)="E" D EN^DIQ1 K DIC,DA,DR,DIQ
S BCHCAT=$E(^UTILITY("DIQ1",$J,90002,BCHR,.03,"E"),1,14) ;ihs/tucson/lab - patch 3 changed file #
K ^UTILITY("DIQ1",$J)
K DIQ,DIC,DA,DR
S DIC="^BCHR(",DR=".06",DA=BCHR,DIQ(0)="E" D EN^DIQ1 K DIC,DA,DR,DIQ
S BCHACT=$E(^UTILITY("DIQ1",$J,90002,BCHR,.06,"E"),1,7) ;IHS/TUCSON/LAB - changed file number patch 3
W !!,BCHDATE,?22,BCHNAME,?43,BCHHRCN,?50,BCHPROG,?56,BCHCAT,?74,BCHACT,!,^XTMP("BCHEXC",BCHJOB,BCHBT,"ERRORS",BCHR)
Q
CHKDISC ;
Q:'$D(^VA(200,BCHAP))
S BCHDISC=$$PPCLSC^BCHUTIL(BCHRPROC)
S BCHINI=$$PPINI^BCHUTIL(BCHRPROC)
Q
HEAD ;ENTRY POINT
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="" Q
HEAD1 ;
W:$D(IOF) @IOF S BCHPG=BCHPG+1
W ?(80-$L($P(^DIC(4,DUZ(2),0),U))/2),$P(^DIC(4,DUZ(2),0),U),?72,"Page ",BCHPG,!
S BCHLENG=26
W ?((80-BCHLENG)/2),"CHR EXPORT RECORD REVIEW",!
W ?15,"Record Posting Dates: ",BCHBDD," and ",BCHEDD,!
W !!,"RECORD DATE",?22,"PATIENT",?43,"HRN",?51,"PGM",?56,"CHR",?72,"ACT LOC" ;IHS/TUCSON/LAB - 6/27/97 - TYPE to CHR
W !,BCH80D
Q
BCHEXCP ; IHS/CMI/LAB - PRNT RECORD REVIEW ;
+1 ;;2.0;IHS RPMS CHR SYSTEM;;OCT 23, 2012;Build 27
+2 ;IHS/CMI/LAB - tmp to xtmp
+3 ;
+4 ;IHS/TUCSON/LAB - PATCH 3 CHANGED FILE NUMBERS AND FIELD NUMBER ON CHR DISPLAY
+5 ;Print export record check report.
+6 ;
START ;
+1 SET BCH80E="==============================================================================="
+2 SET BCH80D="-------------------------------------------------------------------------------"
+3 SET Y=BCHBD
DO DD^%DT
SET BCHBDD=Y
SET Y=BCHED
DO DD^%DT
SET BCHEDD=Y
+4 SET BCHPG=0
DO HEAD
IF '$DATA(^XTMP("BCHEXC",BCHJOB,BCHBT))
WRITE !,"No errors to report",!
GOTO DONE
+5 SET BCHR=0
KILL BCHQUIT
+6 FOR
SET BCHR=$ORDER(^XTMP("BCHEXC",BCHJOB,BCHBT,"ERRORS",BCHR))
IF BCHR=""!($DATA(BCHQUIT))
QUIT
DO PROC
+7 IF $DATA(BCHQUIT)
GOTO DONE
+8 IF $Y>(IOSL-6)
DO HEAD
IF $DATA(BCHQUIT)
GOTO DONE
DONE ;
+1 DO DONE^BCHUTIL1
+2 KILL ^XTMP("BCHEXC",BCHJOB,BCHBT)
+3 QUIT
PROC ;
+1 IF $Y>(IOSL-5)
DO HEAD
IF $DATA(BCHQUIT)
QUIT
+2 SET Y=$PIECE(^BCHR(BCHR,0),U)
DO DD^%DT
SET BCHDATE=Y
+3 SET BCHNAME=$PIECE(^BCHR(BCHR,0),U,4)
IF BCHNAME]""
SET BCHNAME=$EXTRACT($PIECE(^DPT(BCHNAME,0),U),1,20)
+4 IF BCHNAME=""
SET BCHNAME=$PIECE($GET(^BCHR(BCHR,11)),U)
+5 SET BCHHRCN=""
IF $PIECE(^BCHR(BCHR,0),U,4)
SET BCHHRCN=$SELECT($DATA(^AUPNPAT($PIECE(^BCHR(BCHR,0),U,4),41,DUZ(2),0)):$PIECE(^(0),U,2),1:"<none>")
+6 SET BCHPROG=$EXTRACT($$VAL^XBDIQ1(90002,BCHR,.02),1,5)
+7 KILL ^UTILITY("DIQ1",$JOB)
+8 KILL DIQ,DIC,DA,DR
+9 SET DIC="^BCHR("
SET DR=".03"
SET DA=BCHR
SET DIQ(0)="E"
DO EN^DIQ1
KILL DIC,DA,DR,DIQ
+10 ;ihs/tucson/lab - patch 3 changed file #
SET BCHCAT=$EXTRACT(^UTILITY("DIQ1",$JOB,90002,BCHR,.03,"E"),1,14)
+11 KILL ^UTILITY("DIQ1",$JOB)
+12 KILL DIQ,DIC,DA,DR
+13 SET DIC="^BCHR("
SET DR=".06"
SET DA=BCHR
SET DIQ(0)="E"
DO EN^DIQ1
KILL DIC,DA,DR,DIQ
+14 ;IHS/TUCSON/LAB - changed file number patch 3
SET BCHACT=$EXTRACT(^UTILITY("DIQ1",$JOB,90002,BCHR,.06,"E"),1,7)
+15 WRITE !!,BCHDATE,?22,BCHNAME,?43,BCHHRCN,?50,BCHPROG,?56,BCHCAT,?74,BCHACT,!,^XTMP("BCHEXC",BCHJOB,BCHBT,"ERRORS",BCHR)
+16 QUIT
CHKDISC ;
+1 IF '$DATA(^VA(200,BCHAP))
QUIT
+2 SET BCHDISC=$$PPCLSC^BCHUTIL(BCHRPROC)
+3 SET BCHINI=$$PPINI^BCHUTIL(BCHRPROC)
+4 QUIT
HEAD ;ENTRY POINT
+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=""
QUIT
HEAD1 ;
+1 IF $DATA(IOF)
WRITE @IOF
SET BCHPG=BCHPG+1
+2 WRITE ?(80-$LENGTH($PIECE(^DIC(4,DUZ(2),0),U))/2),$PIECE(^DIC(4,DUZ(2),0),U),?72,"Page ",BCHPG,!
+3 SET BCHLENG=26
+4 WRITE ?((80-BCHLENG)/2),"CHR EXPORT RECORD REVIEW",!
+5 WRITE ?15,"Record Posting Dates: ",BCHBDD," and ",BCHEDD,!
+6 ;IHS/TUCSON/LAB - 6/27/97 - TYPE to CHR
WRITE !!,"RECORD DATE",?22,"PATIENT",?43,"HRN",?51,"PGM",?56,"CHR",?72,"ACT LOC"
+7 WRITE !,BCH80D
+8 QUIT
