Routine: BCHRPT0

BCHRPT0 ; IHS/CMI/LAB - MENUS FOR REPORT DRIVER ;

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

PMENU ;EP

 K BCHDISP,BCHSEL,BCHHIGH

 W:$D(IOF) @IOF

 S BCHLHDR="PRINT DATA ITEMS Menu" W ?((80-$L(BCHLHDR))/2),BCHLHDR,!

 W "The following data items can be printed.  You can use up to 132 characters.",!,"Choose the data items in the order you want them printed.",!

 W ?15,"Total Report width (including column margins - 2 spaces):   ",BCHTCW

 S BCHHIGH=0,X=0 F  S X=$O(^BCHSORT("C",X)) Q:X'=+X  S Y=$O(^BCHSORT("C",X,"")) I $P(^BCHSORT(Y,0),U,5)["P",$P(^(0),U,11)["V" S BCHHIGH=BCHHIGH+1,BCHSEL(BCHHIGH)=Y

 S BCHCUT=((BCHHIGH/2)+.5)\1

 S I=0,J=1 F  S I=$O(BCHSEL(I)) Q:I'=+I  I '$D(BCHDISP(I)) D

 .W !?2,I,")  ",$P(^BCHSORT(BCHSEL(I),0),U) S BCHDISP(I)="",J=I+BCHCUT I $D(BCHSEL(J)),'$D(BCHDISP(J)) W ?40,J,")  ",$P(^BCHSORT(BCHSEL(J),0),U) S BCHDISP(J)=""

 W !?7,"<Enter a list or a range.  E.g. 1-4,5,20 or 10,12,20,30>"

 W !?7,"<<HIT RETURN to conclude selections or '^' to exit>>"

SMENU ;EP

 K BCHDISP,BCHSEL,BCHHIGH

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

 W !,"The records displayed can be selected based on any of the following criteria:",!

 S BCHHIGH=0,X=0 F  S X=$O(^BCHSORT(BCHXREF,X)) Q:X'=+X  S Y=$O(^BCHSORT(BCHXREF,X,"")) I $P(^BCHSORT(Y,0),U,5)["S" S BCHHIGH=BCHHIGH+1,BCHSEL(BCHHIGH)=Y

 S BCHCUT=((BCHHIGH/3)+1)\1

 S I=0,J=1,K=1 F  S I=$O(BCHSEL(I)) Q:I'=+I!($D(BCHDISP(I)))  D

  .W !,I,") ",$E($P(^BCHSORT(BCHSEL(I),0),U),1,23) S BCHDISP(I)=""

 .S J=I+BCHCUT I $D(BCHSEL(J)),'$D(BCHDISP(J)) W ?27,J,") ",$E($P(^BCHSORT(BCHSEL(J),0),U),1,22) S BCHDISP(J)=""

 .S K=J+BCHCUT I $D(BCHSEL(K)),'$D(BCHDISP(K)) W ?53,K,") ",$E($P(^BCHSORT(BCHSEL(K),0),U),1,22) S BCHDISP(K)=""

 W !?9,"<Enter a list or a range.  E.g. 1-4,5,20 or 10,12,20,30>"

 W !?9,"<<HIT RETURN to conclude selections or bypass screens>>"

RMENU ;EP - SORT MENU

 K BCHDISP,BCHSEL,BCHHIGH

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

 W !!,"The records displayed can be sorted by any one of the following:",!

 S BCHHIGH=0,X=0 F  S X=$O(^BCHSORT("C",X)) Q:X'=+X  S Y=$O(^BCHSORT("C",X,"")) I $P(^BCHSORT(Y,0),U,5)["R" S BCHHIGH=BCHHIGH+1,BCHSEL(BCHHIGH)=Y

 S BCHCUT=((BCHHIGH/3)+1)\1

 S I=0,J=1,K=1 F  S I=$O(BCHSEL(I)) Q:I'=+I!($D(BCHDISP(I)))  D

 .W !,I,") ",$E($P(^BCHSORT(BCHSEL(I),0),U),1,23) S BCHDISP(I)=""

 .S J=I+BCHCUT I $D(BCHSEL(J)),'$D(BCHDISP(J)) W ?27,J,") ",$E($P(^BCHSORT(BCHSEL(J),0),U),1,22) S BCHDISP(J)=""

 .S K=J+BCHCUT I $D(BCHSEL(K)),'$D(BCHDISP(K)) W ?53,K,") ",$E($P(^BCHSORT(BCHSEL(K),0),U),1,22) S BCHDISP(K)=""

 W !!,"<<If you don't select a sort criteria the report will be sorted by Record date>>"

Y ;EP

 S DIR(0)="S^1:"_BCHTEXT_";0:NO "_BCHTEXT_"",DIR("A")="Choose one",DIR("B")="1" D ^DIR K DIR S:$D(DUOUT) DIRUT=1

 Q:$D(DIRUT)

 Q:Y=""

 S ^BCHTRPT(BCHRPT,11,BCHCRIT,0)=BCHCRIT,^BCHTRPT(BCHRPT,11,"B",BCHCRIT,BCHCRIT)=""

 S ^BCHTRPT(BCHRPT,11,BCHCRIT,11,1,0)=Y,^BCHTRPT(BCHRPT,11,BCHCRIT,11,"B",Y,1)="",^BCHTRPT(BCHRPT,11,BCHCRIT,11,0)="^90002.42110101A^"_1_"^"_1

BCHRPT0   ; IHS/CMI/LAB - MENUS FOR REPORT DRIVER ;

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

 +2       ;

PMENU     ;EP

 +1        KILL BCHDISP,BCHSEL,BCHHIGH

 +2        IF $DATA(IOF)

               WRITE @IOF

 +3        SET BCHLHDR="PRINT DATA ITEMS Menu"

           WRITE ?((80-$LENGTH(BCHLHDR))/2),BCHLHDR,!

 +4        WRITE "The following data items can be printed.  You can use up to 132 characters.",!,"Choose the data items in the order you want them printed.",!

 +5        WRITE ?15,"Total Report width (including column margins - 2 spaces):   ",BCHTCW

 +6        SET BCHHIGH=0

           SET X=0

FOR

               SET X=$ORDER(^BCHSORT("C",X))

               IF X'=+X

                   QUIT

               SET Y=$ORDER(^BCHSORT("C",X,""))

               IF $PIECE(^BCHSORT(Y,0),U,5)["P"

                   IF $PIECE(^(0),U,11)["V"

                       SET BCHHIGH=BCHHIGH+1

                       SET BCHSEL(BCHHIGH)=Y

 +7        SET BCHCUT=((BCHHIGH/2)+.5)\1

 +8        SET I=0

           SET J=1

FOR

               SET I=$ORDER(BCHSEL(I))

               IF I'=+I

                   QUIT

               IF '$DATA(BCHDISP(I))

                   Begin DoDot:1

 +9                    WRITE !?2,I,")  ",$PIECE(^BCHSORT(BCHSEL(I),0),U)

                       SET BCHDISP(I)=""

                       SET J=I+BCHCUT

                       IF $DATA(BCHSEL(J))

                           IF '$DATA(BCHDISP(J))

                               WRITE ?40,J,")  ",$PIECE(^BCHSORT(BCHSEL(J),0),U)

                               SET BCHDISP(J)=""

                   End DoDot:1

 +10       WRITE !?7,"<Enter a list or a range.  E.g. 1-4,5,20 or 10,12,20,30>"

 +11       WRITE !?7,"<<HIT RETURN to conclude selections or '^' to exit>>"

 +12       QUIT

SMENU     ;EP

 +1        KILL BCHDISP,BCHSEL,BCHHIGH

 +2        IF $Y>(IOSL-4)

               IF $DATA(IOF)

                   WRITE @IOF

 +3        WRITE !,"The records displayed can be selected based on any of the following criteria:",!

 +4        SET BCHHIGH=0

           SET X=0

FOR

               SET X=$ORDER(^BCHSORT(BCHXREF,X))

               IF X'=+X

                   QUIT

               SET Y=$ORDER(^BCHSORT(BCHXREF,X,""))

               IF $PIECE(^BCHSORT(Y,0),U,5)["S"

                   SET BCHHIGH=BCHHIGH+1

                   SET BCHSEL(BCHHIGH)=Y

 +5        SET BCHCUT=((BCHHIGH/3)+1)\1

 +6        SET I=0

           SET J=1

           SET K=1

FOR

               SET I=$ORDER(BCHSEL(I))

               IF I'=+I!($DATA(BCHDISP(I)))

                   QUIT

               Begin DoDot:1

 +7                WRITE !,I,") ",$EXTRACT($PIECE(^BCHSORT(BCHSEL(I),0),U),1,23)

                   SET BCHDISP(I)=""

 +8                SET J=I+BCHCUT

                   IF $DATA(BCHSEL(J))

                       IF '$DATA(BCHDISP(J))

                           WRITE ?27,J,") ",$EXTRACT($PIECE(^BCHSORT(BCHSEL(J),0),U),1,22)

                           SET BCHDISP(J)=""

 +9                SET K=J+BCHCUT

                   IF $DATA(BCHSEL(K))

                       IF '$DATA(BCHDISP(K))

                           WRITE ?53,K,") ",$EXTRACT($PIECE(^BCHSORT(BCHSEL(K),0),U),1,22)

                           SET BCHDISP(K)=""

               End DoDot:1

 +10       WRITE !?9,"<Enter a list or a range.  E.g. 1-4,5,20 or 10,12,20,30>"

 +11       WRITE !?9,"<<HIT RETURN to conclude selections or bypass screens>>"

 +12       QUIT

RMENU     ;EP - SORT MENU

 +1        KILL BCHDISP,BCHSEL,BCHHIGH

 +2        IF $Y>(IOSL-4)

               IF $DATA(IOF)

                   WRITE @IOF

 +3        WRITE !!,"The records displayed can be sorted by any one of the following:",!

 +4        SET BCHHIGH=0

           SET X=0

FOR

               SET X=$ORDER(^BCHSORT("C",X))

               IF X'=+X

                   QUIT

               SET Y=$ORDER(^BCHSORT("C",X,""))

               IF $PIECE(^BCHSORT(Y,0),U,5)["R"

                   SET BCHHIGH=BCHHIGH+1

                   SET BCHSEL(BCHHIGH)=Y

 +5        SET BCHCUT=((BCHHIGH/3)+1)\1

 +6        SET I=0

           SET J=1

           SET K=1

FOR

               SET I=$ORDER(BCHSEL(I))

               IF I'=+I!($DATA(BCHDISP(I)))

                   QUIT

               Begin DoDot:1

 +7                WRITE !,I,") ",$EXTRACT($PIECE(^BCHSORT(BCHSEL(I),0),U),1,23)

                   SET BCHDISP(I)=""

 +8                SET J=I+BCHCUT

                   IF $DATA(BCHSEL(J))

                       IF '$DATA(BCHDISP(J))

                           WRITE ?27,J,") ",$EXTRACT($PIECE(^BCHSORT(BCHSEL(J),0),U),1,22)

                           SET BCHDISP(J)=""

 +9                SET K=J+BCHCUT

                   IF $DATA(BCHSEL(K))

                       IF '$DATA(BCHDISP(K))

                           WRITE ?53,K,") ",$EXTRACT($PIECE(^BCHSORT(BCHSEL(K),0),U),1,22)

                           SET BCHDISP(K)=""

               End DoDot:1

 +10       WRITE !!,"<<If you don't select a sort criteria the report will be sorted by Record date>>"

 +11       QUIT

Y         ;EP

 +1        SET DIR(0)="S^1:"_BCHTEXT_";0:NO "_BCHTEXT_""

           SET DIR("A")="Choose one"

           SET DIR("B")="1"

           DO ^DIR

           KILL DIR

           IF $DATA(DUOUT)

               SET DIRUT=1

 +2        IF $DATA(DIRUT)

               QUIT

 +3        IF Y=""

               QUIT

 +4        SET ^BCHTRPT(BCHRPT,11,BCHCRIT,0)=BCHCRIT

           SET ^BCHTRPT(BCHRPT,11,"B",BCHCRIT,BCHCRIT)=""

 +5        SET ^BCHTRPT(BCHRPT,11,BCHCRIT,11,1,0)=Y

           SET ^BCHTRPT(BCHRPT,11,BCHCRIT,11,"B",Y,1)=""

           SET ^BCHTRPT(BCHRPT,11,BCHCRIT,11,0)="^90002.42110101A^"_1_"^"_1

 +6        QUIT

BCHRPT0.m