BCHRPTCP.m

BCHRPTCP ; IHS/CMI/LAB - generic report cover page ; 

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

 ;IHS/CMI/LAB - tmp to xtmp

 ;

COVPAGE ;EP

 ;W:$D(IOF) @IOF

 W:IOST["C-" @IOF

 W !!!?31,"CHR RECORD LISTING"

 W !!,"REPORT REQUESTED BY: ",$P(^VA(200,DUZ,0),U)

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

 W !!,"The following visit listing contains CHR records selected based on the",!,"following criteria:",!

SHOW ;

 W !?28,"RECORD SELECTION CRITERIA"

 W !!,"PATIENTS: ",BCHREGN

 W !!,"Date of Service range:  ",BCHBDD," to ",BCHEDD,!

 I '$D(^BCHTRPT(BCHRPT,11)) G SHOWP

 S BCHI=0 F  S BCHI=$O(^BCHTRPT(BCHRPT,11,BCHI)) Q:BCHI'=+BCHI  D

 .I $Y>(IOSL-4) D PAUSE^BCHRPTU W @IOF

 .W !,$P(^BCHSORT(BCHI,0),U),":  "

 .K BCHQ S Y=0,C=0 F  S Y=$O(^BCHTRPT(BCHRPT,11,BCHI,11,"B",Y)) S C=C+1 Q:Y=""!($D(BCHQ))  W:C'=1 " ; " S X=Y X:$D(^BCHSORT(BCHI,2)) ^(2) W X

SHOWP ;

 I $Y>(IOSL-4) D PAUSE^BCHRPTU W @IOF

 I $D(BCHRPTC) W !!,"Report Type: ",$P(^BCHRCNT(BCHRPTC,0),U,6)

 ;I $D(BCHRPTC) W !!,"Report Type: ",$S(BCHRTYPE["D":"DETAILED RECORD LIST",BCHRTYPE["B":"STANDARD BRIEF",1:"??")

 I '$D(^BCHTRPT(BCHRPT,12)) G PAUSE

 W !!?29,"PRINT FIELD SELECTION",!

 S BCHI=0 F  S BCHI=$O(^BCHTRPT(BCHRPT,12,BCHI)) Q:BCHI'=+BCHI  S BCHCRIT=$P(^BCHTRPT(BCHRPT,12,BCHI,0),U) D

 .I $Y>(IOSL-4) D PAUSE^BCHRPTU W:$D(IOF) @IOF

 .W !,$P(^BCHSORT(BCHCRIT,0),U),"  (" S X=$O(^BCHTRPT(BCHRPT,12,"B",BCHCRIT,"")) W $P(^BCHTRPT(BCHRPT,12,X,0),U,2),")"

 W !,"     TOTAL column width: ",BCHTCW

 I $Y>(IOSL-5) D PAUSE^BCHRPTU W:$D(IOF) @IOF

SORT ;

 I $G(BCHSORT)]"" W !!,"Records will be sorted by:  ",$P(^BCHSORT(BCHSORT,0),U),!

 I $G(BCHSPAG) W !,"Each ",$P(^BCHSORT(BCHSORT,0),U)," will be on a separate page.",!

 I $Y>(IOSL-4) D PAUSE^BCHRPTU W:$D(IOF) @IOF

 I '$D(^XTMP("BCHRPT",BCHJOB,BCHBTH)) W !!,"NO RECORDS TO DISPLAY.",!

PAUSE D PAUSE^BCHRPTU

 Q

BCHRPTCP  ; IHS/CMI/LAB - generic report cover page ; 

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

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

 +3       ;

COVPAGE   ;EP

 +1       ;W:$D(IOF) @IOF

 +2        IF IOST["C-"

               WRITE @IOF

 +3        WRITE !!!?31,"CHR RECORD LISTING"

 +4        WRITE !!,"REPORT REQUESTED BY: ",$PIECE(^VA(200,DUZ,0),U)

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

 +6        WRITE !!,"The following visit listing contains CHR records selected based on the",!,"following criteria:",!

SHOW      ;

 +1        WRITE !?28,"RECORD SELECTION CRITERIA"

 +2        WRITE !!,"PATIENTS: ",BCHREGN

 +3        WRITE !!,"Date of Service range:  ",BCHBDD," to ",BCHEDD,!

 +4        IF '$DATA(^BCHTRPT(BCHRPT,11))

               GOTO SHOWP

 +5        SET BCHI=0

           FOR 

               SET BCHI=$ORDER(^BCHTRPT(BCHRPT,11,BCHI))

               IF BCHI'=+BCHI

                   QUIT 

               Begin DoDot:1

 +6                IF $Y>(IOSL-4)

                       DO PAUSE^BCHRPTU

                       WRITE @IOF

 +7                WRITE !,$PIECE(^BCHSORT(BCHI,0),U),":  "

 +8                KILL BCHQ

                   SET Y=0

                   SET C=0

                   FOR 

                       SET Y=$ORDER(^BCHTRPT(BCHRPT,11,BCHI,11,"B",Y))

                       SET C=C+1

                       IF Y=""!($DATA(BCHQ))

                           QUIT 

                       IF C'=1

                           WRITE " ; "

                       SET X=Y

                       IF $DATA(^BCHSORT(BCHI,2))

                           XECUTE ^(2)

                       WRITE X

               End DoDot:1

SHOWP     ;

 +1        IF $Y>(IOSL-4)

               DO PAUSE^BCHRPTU

               WRITE @IOF

 +2        IF $DATA(BCHRPTC)

               WRITE !!,"Report Type: ",$PIECE(^BCHRCNT(BCHRPTC,0),U,6)

 +3       ;I $D(BCHRPTC) W !!,"Report Type: ",$S(BCHRTYPE["D":"DETAILED RECORD LIST",BCHRTYPE["B":"STANDARD BRIEF",1:"??")

 +4        IF '$DATA(^BCHTRPT(BCHRPT,12))

               GOTO PAUSE

 +5        WRITE !!?29,"PRINT FIELD SELECTION",!

 +6        SET BCHI=0

           FOR 

               SET BCHI=$ORDER(^BCHTRPT(BCHRPT,12,BCHI))

               IF BCHI'=+BCHI

                   QUIT 

               SET BCHCRIT=$PIECE(^BCHTRPT(BCHRPT,12,BCHI,0),U)

               Begin DoDot:1

 +7                IF $Y>(IOSL-4)

                       DO PAUSE^BCHRPTU

                       IF $DATA(IOF)

                           WRITE @IOF

 +8                WRITE !,$PIECE(^BCHSORT(BCHCRIT,0),U),"  ("

                   SET X=$ORDER(^BCHTRPT(BCHRPT,12,"B",BCHCRIT,""))

                   WRITE $PIECE(^BCHTRPT(BCHRPT,12,X,0),U,2),")"

               End DoDot:1

 +9        WRITE !,"     TOTAL column width: ",BCHTCW

 +10       IF $Y>(IOSL-5)

               DO PAUSE^BCHRPTU

               IF $DATA(IOF)

                   WRITE @IOF

SORT      ;

 +1        IF $GET(BCHSORT)]""

               WRITE !!,"Records will be sorted by:  ",$PIECE(^BCHSORT(BCHSORT,0),U),!

 +2        IF $GET(BCHSPAG)

               WRITE !,"Each ",$PIECE(^BCHSORT(BCHSORT,0),U)," will be on a separate page.",!

 +3        IF $Y>(IOSL-4)

               DO PAUSE^BCHRPTU

               IF $DATA(IOF)

                   WRITE @IOF

 +4        IF '$DATA(^XTMP("BCHRPT",BCHJOB,BCHBTH))

               WRITE !!,"NO RECORDS TO DISPLAY.",!

PAUSE      DO PAUSE^BCHRPTU

 +1        QUIT