- 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
