BCHRL2 ; IHS/CMI/LAB -CONT OF BCHRL ;
;;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(BCHXREF,X)) Q:X'=+X S Y=$O(^BCHSORT(BCHXREF,X,"")) I $P(^BCHSORT(Y,0),U,5)["P" 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,") ",$S($P(^BCHSORT(BCHSEL(I),0),U,14)="":$E($P(^(0),U),1,20),1:$P(^(0),U,14)) S BCHDISP(I)=""
.S J=I+BCHCUT I $D(BCHSEL(J)),'$D(BCHDISP(J)) W ?27,J,") ",$S($P(^BCHSORT(BCHSEL(J),0),U,14)="":$E($P(^BCHSORT(BCHSEL(J),0),U),1,20),1:$P(^(0),U,14)) S BCHDISP(J)=""
.S K=J+BCHCUT I $D(BCHSEL(K)),'$D(BCHDISP(K)) W ?55,K,") ",$S($P(^BCHSORT(BCHSEL(K),0),U,14)="":$E($P(^BCHSORT(BCHSEL(K),0),U),1,20),1:$P(^(0),U,14)) S BCHDISP(K)=""
W !?7,"<Enter a list or a range. E.g. 1-4,5,20 or 10,12,20,30>"
W !?7,"<<PRESS Enter to conclude selections or '^' to exit>>"
Q
K BCHDISP,BCHSEL,BCHHIGH
I $Y>(IOSL-4) W:$D(IOF) @IOF
W !!,"The ",$S(BCHPTVS="P":"Patients",1:"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,20) 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,20) S BCHDISP(K)=""
W !!?9,"<Enter a list or a range. E.g. 1-4,5,20 or 10,12,20,30>"
W !?9,"<<PRESS Enter to conclude selections or bypass screens>>"
Q
K BCHDISP,BCHSEL,BCHHIGH
I $Y>(IOSL-4) W:$D(IOF) @IOF
W !!,"The ",$S(BCHPTVS="P":"Patients",1:"records")," displayed can be SORTED by any one of the following:",!
S BCHHIGH=0,X=0 F S X=$O(^BCHSORT(X)) Q:X'=+X I $P(^BCHSORT(X,0),U,5)["R" S BCHHIGH=BCHHIGH+1,BCHSEL(BCHHIGH)=X
S BCHCUT=((BCHHIGH/2)+1)\1
S I=0,J=1,K=1 F S I=$O(BCHSEL(I)) Q:I'=+I!($D(BCHDISP(I))) W !?5,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 !!,"<<If you don't select a sort criteria the report will be sorted by ",$S(BCHPTVS="V":"Date",1:"Patient"),".>>"
Q
BCHRL2 ; IHS/CMI/LAB -CONT OF BCHRL ;
+1 ;;2.0;IHS RPMS CHR SYSTEM;;OCT 23, 2012;Build 27
+2 ;
+3 ;
+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(BCHXREF,X))
IF X'=+X
QUIT
SET Y=$ORDER(^BCHSORT(BCHXREF,X,""))
IF $PIECE(^BCHSORT(Y,0),U,5)["P"
SET BCHHIGH=BCHHIGH+1
SET BCHSEL(BCHHIGH)=Y
+7 SET BCHCUT=((BCHHIGH/3)+1)\1
+8 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
+9 WRITE !,I,") ",$SELECT($PIECE(^BCHSORT(BCHSEL(I),0),U,14)="":$EXTRACT($PIECE(^(0),U),1,20),1:$PIECE(^(0),U,14))
SET BCHDISP(I)=""
+10 SET J=I+BCHCUT
IF $DATA(BCHSEL(J))
IF '$DATA(BCHDISP(J))
WRITE ?27,J,") ",$SELECT($PIECE(^BCHSORT(BCHSEL(J),0),U,14)="":$EXTRACT($PIECE(^BCHSORT(BCHSEL(J),0),U),1,20),1:$PIECE(^(0),U,14))
SET BCHDISP(J)=""
+11 SET K=J+BCHCUT
IF $DATA(BCHSEL(K))
IF '$DATA(BCHDISP(K))
WRITE ?55,K,") ",$SELECT($PIECE(^BCHSORT(BCHSEL(K),0),U,14)="":$EXTRACT($PIECE(^BCHSORT(BCHSEL(K),0),U),1,20),1:$PIECE(^(0),U,14))
SET BCHDISP(K)=""
End DoDot:1
+12 WRITE !?7,"<Enter a list or a range. E.g. 1-4,5,20 or 10,12,20,30>"
+13 WRITE !?7,"<<PRESS Enter to conclude selections or '^' to exit>>"
+14 QUIT
+1 KILL BCHDISP,BCHSEL,BCHHIGH
+2 IF $Y>(IOSL-4)
IF $DATA(IOF)
WRITE @IOF
+3 WRITE !!,"The ",$SELECT(BCHPTVS="P":"Patients",1:"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,20)
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,20)
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,"<<PRESS Enter 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 ",$SELECT(BCHPTVS="P":"Patients",1:"records")," displayed can be SORTED by any one of the following:",!
+4 SET BCHHIGH=0
SET X=0
FOR
SET X=$ORDER(^BCHSORT(X))
IF X'=+X
QUIT
IF $PIECE(^BCHSORT(X,0),U,5)["R"
SET BCHHIGH=BCHHIGH+1
SET BCHSEL(BCHHIGH)=X
+5 SET BCHCUT=((BCHHIGH/2)+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
WRITE !?5,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)=""
+7 WRITE !!,"<<If you don't select a sort criteria the report will be sorted by ",$SELECT(BCHPTVS="V":"Date",1:"Patient"),".>>"
+8 QUIT
