BCHRP11.m

BCHRP11 ; IHS/CMI/LAB - DETAILED/BRIEF LISTING OF RECORDS, REPORT 1 ; 

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

 ;IHS/CMI/LAB - patch 8 Y2K

 ;

 ;

HEADER ;EP

 I 'BCHPG G HEADER1

 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

HEADER1 ;

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

 W ?($S(BCHRTYPE="B":16,1:38)),"**********  CONFIDENTIAL PATIENT INFORMATION  **********",!

 W ?(BCHCW-$L($P(^DIC(4,DUZ(2),0),U))/2),$P(^DIC(4,DUZ(2),0),U),?($S(BCHCW=132:120,1:72)),"Page ",BCHPG

 S BCHTEXT="CHR RECORD LISTING"

 W !?(BCHCW-$L(BCHTEXT)/2),BCHTEXT,!

 S BCHTEXT="Record Dates:  "_BCHBDD_" and "_BCHEDD

 W ?(BCHCW-$L(BCHTEXT)/2),BCHTEXT,!

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

 W $TR($J(" ",BCHCW)," ","=")

 ;begin Y2K - reformat header

 I BCHRTYPE="B" W !," DATE",?11,"CHR",?15,"PATIENT NAME",?38,"LOC",?44,"TT",?49,"ASSESSMENTS - POVS" ;Y2000

 E   W !," DATE",?11,"CHR",?15,"PATIENT NAME",?38,"LOC",?44,"TT",?49,"ASSESSMENTS - POVS",?86,"REF BY",?96,"REF TO",?105,"EVAL",?110,"TRV",?116,"# SERVED" ;Y2000

 ;end Y2K

 W !,$TR($J(" ",BCHCW)," ","-")

 Q

BCHRP11   ; IHS/CMI/LAB - DETAILED/BRIEF LISTING OF RECORDS, REPORT 1 ; 

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

 +2       ;IHS/CMI/LAB - patch 8 Y2K

 +3       ;

 +4       ;

HEADER    ;EP

 +1        IF 'BCHPG

               GOTO HEADER1

 +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 

HEADER1   ;

 +1        IF $DATA(IOF)

               WRITE @IOF

           SET BCHPG=BCHPG+1

 +2        WRITE ?($SELECT(BCHRTYPE="B":16,1:38)),"**********  CONFIDENTIAL PATIENT INFORMATION  **********",!

 +3        WRITE ?(BCHCW-$LENGTH($PIECE(^DIC(4,DUZ(2),0),U))/2),$PIECE(^DIC(4,DUZ(2),0),U),?($SELECT(BCHCW=132:120,1:72)),"Page ",BCHPG

 +4        SET BCHTEXT="CHR RECORD LISTING"

 +5        WRITE !?(BCHCW-$LENGTH(BCHTEXT)/2),BCHTEXT,!

 +6        SET BCHTEXT="Record Dates:  "_BCHBDD_" and "_BCHEDD

 +7        WRITE ?(BCHCW-$LENGTH(BCHTEXT)/2),BCHTEXT,!

 +8        IF $GET(BCHSPAG)

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

               IF BCHCW<BCHLENG

                   SET BCHLENG=BCHCW

               WRITE !?((BCHCW-BCHLENG)/2),BCHSORV,":  ",BCHRSRT,!

 +9        WRITE $TRANSLATE($JUSTIFY(" ",BCHCW)," ","=")

 +10      ;begin Y2K - reformat header

 +11      ;Y2000

           IF BCHRTYPE="B"

               WRITE !," DATE",?11,"CHR",?15,"PATIENT NAME",?38,"LOC",?44,"TT",?49,"ASSESSMENTS - POVS"

 +12      ;Y2000

          IF '$TEST

               WRITE !," DATE",?11,"CHR",?15,"PATIENT NAME",?38,"LOC",?44,"TT",?49,"ASSESSMENTS - POVS",?86,"REF BY",?96,"REF TO",?105,"EVAL",?110,"TRV",?116,"# SERVED"

 +13      ;end Y2K

 +14       WRITE !,$TRANSLATE($JUSTIFY(" ",BCHCW)," ","-")

 +15       QUIT