BCHRPT0 ; IHS/CMI/LAB - MENUS FOR REPORT DRIVER ;
;;2.0;IHS RPMS CHR SYSTEM;;OCT 23, 2012;Build 27
;
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>>"
Q
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>>"
Q
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>>"
Q
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
Q
BCHRPT0 ; IHS/CMI/LAB - MENUS FOR REPORT DRIVER ;
+1 ;;2.0;IHS RPMS CHR SYSTEM;;OCT 23, 2012;Build 27
+2 ;
+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
+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
+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
