BCHRLP2.m

BCHRLP2 ; IHS/CMI/LAB - PRINT GEN RET ; 

 ;;2.0;IHS RPMS CHR SYSTEM;;OCT 23, 2012;Build 27

 ;IHS/CMI/LAB - tmp to xtmp

 ;

DONE ;EP

 D DONE^BCHUTIL1,XIT^BCHRPTU

 K ^XTMP("BCHRL",BCHJOB,BCHBT)

 D DEL^BCHRL

 K BCHBD,BCHSD,BCHED,BCHEDD,BCHBDD,BCHRPT,BCHHEAD,BCHLINE,BCHL,BCHRCNT,BCHI,BCHCRIT,BCHR,BCHRREC,BCHJOB,BCHBT,BCHBTH,BCHQUIT,BCHHDR,BCHDASH,BCHLENG,BCHPCNT,BCHTCW,BCHODAT,BCHPG,AUPNDAYS,AUPNPAT,AUPNDOD,AUPNDOB,AUPNSEX

 K BCHSORT,BCHSRT,BCHSORX,BCHFILE,BCHFIEL,BCHPRNT,BCHX,BCHTYPE,BCHFOUN,D0,J,K,L,BCHPRNM,BCHTEST,BCHSEAT,BCHLHDR,BCHFRST

 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 ;EP

 W:$D(IOF) @IOF S BCHPG=BCHPG+1

 W ?16,"**********  CONFIDENTIAL PATIENT INFORMATION  **********"

 I $G(BCHTITL)="" S BCHTEXT="CHR "_$S(BCHPTVS="V":"ENCOUNTER",1:"PATIENT")_" LISTING",BCHLENG=$L(BCHTEXT) W !?((BCHTCW-BCHLENG)/2),BCHTEXT,?(BCHTCW-8),"Page ",BCHPG

 I $G(BCHTITL)]"" S BCHLENG=$L(BCHTITL) W !?((BCHTCW-BCHLENG)/2),BCHTITL,?(BCHTCW-8),"Page ",BCHPG

 W !,$$CTR^BCHRLU($$LOC^BCHRLU)

 I BCHTYPE="D" S BCHLENG=46 S:BCHTCW<BCHLENG BCHLENG=BCHTCW W !?((BCHTCW-BCHLENG)/2),"Record Dates:  ",BCHBDD," and ",BCHEDD,!

 I BCHTYPE="S" S BCHLENG=16+$L($P(^DIBT(BCHSEAT,0),U)) S:BCHTCW<BCHLENG BCHLENG=BCHTCW  W !?((BCHTCW-BCHLENG)/2),"Search Template: ",$P(^DIBT(BCHSEAT,0),U),!

 I BCHCTYP="S" S BCHLENG=$L(BCHSORV)+23 W !?((BCHTCW-BCHLENG)/2),$S(BCHPTVS="V":"ENCOUNTER",1:"PATIENT")," SUB-TOTALS BY:  ",BCHSORV,!

 I $G(BCHSPAG) S BCHLENG=$L(BCHSRTR)+$L(BCHSORV)+2 S:BCHTCW<BCHLENG BCHLENG=BCHTCW W !?((BCHTCW-BCHLENG)/2),BCHSORV,":  ",BCHSRTR,!

 I BCHHEAD]"" W !,BCHHEAD,!

 W BCHDASH,!

 I BCHCTYP="S" W !,BCHSORV,":"

 Q

BCHRLP2   ; IHS/CMI/LAB - PRINT GEN RET ; 

 +1       ;;2.0;IHS RPMS CHR SYSTEM;;OCT 23, 2012;Build 27

 +2       ;IHS/CMI/LAB - tmp to xtmp

 +3       ;

DONE      ;EP

 +1        DO DONE^BCHUTIL1

           DO XIT^BCHRPTU

 +2        KILL ^XTMP("BCHRL",BCHJOB,BCHBT)

 +3        DO DEL^BCHRL

 +4        KILL BCHBD,BCHSD,BCHED,BCHEDD,BCHBDD,BCHRPT,BCHHEAD,BCHLINE,BCHL,BCHRCNT,BCHI,BCHCRIT,BCHR,BCHRREC,BCHJOB,BCHBT,BCHBTH,BCHQUIT,BCHHDR,BCHDASH,BCHLENG,BCHPCNT,BCHTCW,BCHODAT,BCHPG,AUPNDAYS,AUPNPAT,AUPNDOD,AUPNDOB,AUPNSEX

 +5        KILL BCHSORT,BCHSRT,BCHSORX,BCHFILE,BCHFIEL,BCHPRNT,BCHX,BCHTYPE,BCHFOUN,D0,J,K,L,BCHPRNM,BCHTEST,BCHSEAT,BCHLHDR,BCHFRST

 +6        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     ;EP

 +1        IF $DATA(IOF)

               WRITE @IOF

           SET BCHPG=BCHPG+1

 +2        WRITE ?16,"**********  CONFIDENTIAL PATIENT INFORMATION  **********"

 +3        IF $GET(BCHTITL)=""

               SET BCHTEXT="CHR "_$SELECT(BCHPTVS="V":"ENCOUNTER",1:"PATIENT")_" LISTING"

               SET BCHLENG=$LENGTH(BCHTEXT)

               WRITE !?((BCHTCW-BCHLENG)/2),BCHTEXT,?(BCHTCW-8),"Page ",BCHPG

 +4        IF $GET(BCHTITL)]""

               SET BCHLENG=$LENGTH(BCHTITL)

               WRITE !?((BCHTCW-BCHLENG)/2),BCHTITL,?(BCHTCW-8),"Page ",BCHPG

 +5        WRITE !,$$CTR^BCHRLU($$LOC^BCHRLU)

 +6        IF BCHTYPE="D"

               SET BCHLENG=46

               IF BCHTCW<BCHLENG

                   SET BCHLENG=BCHTCW

               WRITE !?((BCHTCW-BCHLENG)/2),"Record Dates:  ",BCHBDD," and ",BCHEDD,!

 +7        IF BCHTYPE="S"

               SET BCHLENG=16+$LENGTH($PIECE(^DIBT(BCHSEAT,0),U))

               IF BCHTCW<BCHLENG

                   SET BCHLENG=BCHTCW

               WRITE !?((BCHTCW-BCHLENG)/2),"Search Template: ",$PIECE(^DIBT(BCHSEAT,0),U),!

 +8        IF BCHCTYP="S"

               SET BCHLENG=$LENGTH(BCHSORV)+23

               WRITE !?((BCHTCW-BCHLENG)/2),$SELECT(BCHPTVS="V":"ENCOUNTER",1:"PATIENT")," SUB-TOTALS BY:  ",BCHSORV,!

 +9        IF $GET(BCHSPAG)

               SET BCHLENG=$LENGTH(BCHSRTR)+$LENGTH(BCHSORV)+2

               IF BCHTCW<BCHLENG

                   SET BCHLENG=BCHTCW

               WRITE !?((BCHTCW-BCHLENG)/2),BCHSORV,":  ",BCHSRTR,!

 +10       IF BCHHEAD]""

               WRITE !,BCHHEAD,!

 +11       WRITE BCHDASH,!

 +12       IF BCHCTYP="S"

               WRITE !,BCHSORV,":"

 +13       QUIT