ACDRL2 ;IHS/ADC/EDE/KML - CONT OF ACDRL;
;;4.1;CHEMICAL DEPENDENCY MIS;;MAY 11, 1998
;
;
K ACDDISP,ACDSEL,ACDHIGH
W:$D(IOF) @IOF
S ACDLHDR="PRINT DATA ITEMS Menu" W ?((80-$L(ACDLHDR))/2),ACDLHDR,!
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): ",ACDTCW
S ACDHIGH=0,X=0 F S X=$O(^ACDTITEM(ACDXREF,X)) Q:X'=+X S Y=$O(^ACDTITEM(ACDXREF,X,"")) I $P(^ACDTITEM(Y,0),U,5)["P",$P(^(0),U,11)[ACDPTVS S ACDHIGH=ACDHIGH+1,ACDSEL(ACDHIGH)=Y
;S ACDCUT=((ACDHIGH/3)+1)\1
S ACDCUT=ACDHIGH/3 S:ACDCUT'=(ACDCUT\1) ACDCUT=(ACDCUT\1)+1
S I=0,J=1,K=1 F S I=$O(ACDSEL(I)) Q:I'=+I!($D(ACDDISP(I))) D
.W !,I,") ",$S($P(^ACDTITEM(ACDSEL(I),0),U,14)="":$E($P(^(0),U),1,20),1:$P(^(0),U,14)) S ACDDISP(I)=""
.S J=I+ACDCUT I $D(ACDSEL(J)),'$D(ACDDISP(J)) W ?27,J,") ",$S($P(^ACDTITEM(ACDSEL(J),0),U,14)="":$E($P(^ACDTITEM(ACDSEL(J),0),U),1,20),1:$P(^(0),U,14)) S ACDDISP(J)=""
.S K=J+ACDCUT I $D(ACDSEL(K)),'$D(ACDDISP(K)) W ?55,K,") ",$S($P(^ACDTITEM(ACDSEL(K),0),U,14)="":$E($P(^ACDTITEM(ACDSEL(K),0),U),1,20),1:$P(^(0),U,14)) S ACDDISP(K)=""
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 ACDDISP,ACDSEL,ACDHIGH
I $Y>(IOSL-4) W:$D(IOF) @IOF
W !!,"The ",$S(ACDPTVS="P":"Patients",1:"records")," displayed can be selected based on any of the following criteria:",!
S ACDHIGH=0,X=0 F S X=$O(^ACDTITEM(ACDXREF,X)) Q:X'=+X S Y=$O(^ACDTITEM(ACDXREF,X,"")) I $P(^ACDTITEM(Y,0),U,5)["S",$P(^(0),U,11)[ACDPTVS S ACDHIGH=ACDHIGH+1,ACDSEL(ACDHIGH)=Y
;S ACDCUT=((ACDHIGH/3)+1)\1
S ACDCUT=ACDHIGH/3 S:ACDCUT'=(ACDCUT\1) ACDCUT=(ACDCUT\1)+1
S I=0,J=1,K=1 F S I=$O(ACDSEL(I)) Q:I'=+I!($D(ACDDISP(I))) D
.W !,I,") ",$E($P(^ACDTITEM(ACDSEL(I),0),U),1,23) S ACDDISP(I)=""
.S J=I+ACDCUT I $D(ACDSEL(J)),'$D(ACDDISP(J)) W ?27,J,") ",$E($P(^ACDTITEM(ACDSEL(J),0),U),1,20) S ACDDISP(J)=""
.S K=J+ACDCUT I $D(ACDSEL(K)),'$D(ACDDISP(K)) W ?53,K,") ",$E($P(^ACDTITEM(ACDSEL(K),0),U),1,20) S ACDDISP(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 ACDDISP,ACDSEL,ACDHIGH
I $Y>(IOSL-4) W:$D(IOF) @IOF
W !!,"The ",$S(ACDPTVS="P":"Patients",1:"records")," displayed can be SORTED by any one of the following:",!
S ACDHIGH=0,X=0 F S X=$O(^ACDTITEM(X)) Q:X'=+X I $P(^ACDTITEM(X,0),U,5)["R",$P(^(0),U,11)[ACDPTVS S ACDHIGH=ACDHIGH+1,ACDSEL(ACDHIGH)=X
;S ACDCUT=((ACDHIGH/3)+1)\1
S ACDCUT=ACDHIGH/3 S:ACDCUT'=(ACDCUT\1) ACDCUT=(ACDCUT\1)+1
S I=0,J=1,K=1 F S I=$O(ACDSEL(I)) Q:I'=+I!($D(ACDDISP(I))) D
.W !,I,") ",$E($P(^ACDTITEM(ACDSEL(I),0),U),1,23) S ACDDISP(I)=""
.S J=I+ACDCUT I $D(ACDSEL(J)),'$D(ACDDISP(J)) W ?27,J,") ",$E($P(^ACDTITEM(ACDSEL(J),0),U),1,20) S ACDDISP(J)=""
.S K=J+ACDCUT I $D(ACDSEL(K)),'$D(ACDDISP(K)) W ?53,K,") ",$E($P(^ACDTITEM(ACDSEL(K),0),U),1,20) S ACDDISP(K)=""
W !!,"<<If you don't select a sort criteria the report will be sorted by ",$S(ACDPTVS="V":"Visit date",1:"Patient"),".>>"
Q
ACDRL2 ;IHS/ADC/EDE/KML - CONT OF ACDRL;
+1 ;;4.1;CHEMICAL DEPENDENCY MIS;;MAY 11, 1998
+2 ;
+3 ;
+1 KILL ACDDISP,ACDSEL,ACDHIGH
+2 IF $DATA(IOF)
WRITE @IOF
+3 SET ACDLHDR="PRINT DATA ITEMS Menu"
WRITE ?((80-$LENGTH(ACDLHDR))/2),ACDLHDR,!
+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): ",ACDTCW
+6 SET ACDHIGH=0
SET X=0
FOR
SET X=$ORDER(^ACDTITEM(ACDXREF,X))
IF X'=+X
QUIT
SET Y=$ORDER(^ACDTITEM(ACDXREF,X,""))
IF $PIECE(^ACDTITEM(Y,0),U,5)["P"
IF $PIECE(^(0),U,11)[ACDPTVS
SET ACDHIGH=ACDHIGH+1
SET ACDSEL(ACDHIGH)=Y
+7 ;S ACDCUT=((ACDHIGH/3)+1)\1
+8 SET ACDCUT=ACDHIGH/3
IF ACDCUT'=(ACDCUT\1)
SET ACDCUT=(ACDCUT\1)+1
+9 SET I=0
SET J=1
SET K=1
FOR
SET I=$ORDER(ACDSEL(I))
IF I'=+I!($DATA(ACDDISP(I)))
QUIT
Begin DoDot:1
+10 WRITE !,I,") ",$SELECT($PIECE(^ACDTITEM(ACDSEL(I),0),U,14)="":$EXTRACT($PIECE(^(0),U),1,20),1:$PIECE(^(0),U,14))
SET ACDDISP(I)=""
+11 SET J=I+ACDCUT
IF $DATA(ACDSEL(J))
IF '$DATA(ACDDISP(J))
WRITE ?27,J,") ",$SELECT($PIECE(^ACDTITEM(ACDSEL(J),0),U,14)="":$EXTRACT($PIECE(^ACDTITEM(ACDSEL(J),0),U),1,20),1:$PIECE(^(0),U,14))
SET ACDDISP(J)=""
+12 SET K=J+ACDCUT
IF $DATA(ACDSEL(K))
IF '$DATA(ACDDISP(K))
WRITE ?55,K,") ",$SELECT($PIECE(^ACDTITEM(ACDSEL(K),0),U,14)="":$EXTRACT($PIECE(^ACDTITEM(ACDSEL(K),0),U),1,20),1:$PIECE(^(0),U,14))
SET ACDDISP(K)=""
End DoDot:1
+13 WRITE !?7,"<Enter a list or a range. E.g. 1-4,5,20 or 10,12,20,30>"
+14 WRITE !?7,"<<HIT RETURN to conclude selections or '^' to exit>>"
+15 QUIT
+1 KILL ACDDISP,ACDSEL,ACDHIGH
+2 IF $Y>(IOSL-4)
IF $DATA(IOF)
WRITE @IOF
+3 WRITE !!,"The ",$SELECT(ACDPTVS="P":"Patients",1:"records")," displayed can be selected based on any of the following criteria:",!
+4 SET ACDHIGH=0
SET X=0
FOR
SET X=$ORDER(^ACDTITEM(ACDXREF,X))
IF X'=+X
QUIT
SET Y=$ORDER(^ACDTITEM(ACDXREF,X,""))
IF $PIECE(^ACDTITEM(Y,0),U,5)["S"
IF $PIECE(^(0),U,11)[ACDPTVS
SET ACDHIGH=ACDHIGH+1
SET ACDSEL(ACDHIGH)=Y
+5 ;S ACDCUT=((ACDHIGH/3)+1)\1
+6 SET ACDCUT=ACDHIGH/3
IF ACDCUT'=(ACDCUT\1)
SET ACDCUT=(ACDCUT\1)+1
+7 SET I=0
SET J=1
SET K=1
FOR
SET I=$ORDER(ACDSEL(I))
IF I'=+I!($DATA(ACDDISP(I)))
QUIT
Begin DoDot:1
+8 WRITE !,I,") ",$EXTRACT($PIECE(^ACDTITEM(ACDSEL(I),0),U),1,23)
SET ACDDISP(I)=""
+9 SET J=I+ACDCUT
IF $DATA(ACDSEL(J))
IF '$DATA(ACDDISP(J))
WRITE ?27,J,") ",$EXTRACT($PIECE(^ACDTITEM(ACDSEL(J),0),U),1,20)
SET ACDDISP(J)=""
+10 SET K=J+ACDCUT
IF $DATA(ACDSEL(K))
IF '$DATA(ACDDISP(K))
WRITE ?53,K,") ",$EXTRACT($PIECE(^ACDTITEM(ACDSEL(K),0),U),1,20)
SET ACDDISP(K)=""
End DoDot:1
+11 WRITE !!?9,"<Enter a list or a range. E.g. 1-4,5,20 or 10,12,20,30>"
+12 WRITE !?9,"<<HIT RETURN to conclude selections or bypass screens>>"
+13 QUIT
+1 KILL ACDDISP,ACDSEL,ACDHIGH
+2 IF $Y>(IOSL-4)
IF $DATA(IOF)
WRITE @IOF
+3 WRITE !!,"The ",$SELECT(ACDPTVS="P":"Patients",1:"records")," displayed can be SORTED by any one of the following:",!
+4 SET ACDHIGH=0
SET X=0
FOR
SET X=$ORDER(^ACDTITEM(X))
IF X'=+X
QUIT
IF $PIECE(^ACDTITEM(X,0),U,5)["R"
IF $PIECE(^(0),U,11)[ACDPTVS
SET ACDHIGH=ACDHIGH+1
SET ACDSEL(ACDHIGH)=X
+5 ;S ACDCUT=((ACDHIGH/3)+1)\1
+6 SET ACDCUT=ACDHIGH/3
IF ACDCUT'=(ACDCUT\1)
SET ACDCUT=(ACDCUT\1)+1
+7 SET I=0
SET J=1
SET K=1
FOR
SET I=$ORDER(ACDSEL(I))
IF I'=+I!($DATA(ACDDISP(I)))
QUIT
Begin DoDot:1
+8 WRITE !,I,") ",$EXTRACT($PIECE(^ACDTITEM(ACDSEL(I),0),U),1,23)
SET ACDDISP(I)=""
+9 SET J=I+ACDCUT
IF $DATA(ACDSEL(J))
IF '$DATA(ACDDISP(J))
WRITE ?27,J,") ",$EXTRACT($PIECE(^ACDTITEM(ACDSEL(J),0),U),1,20)
SET ACDDISP(J)=""
+10 SET K=J+ACDCUT
IF $DATA(ACDSEL(K))
IF '$DATA(ACDDISP(K))
WRITE ?53,K,") ",$EXTRACT($PIECE(^ACDTITEM(ACDSEL(K),0),U),1,20)
SET ACDDISP(K)=""
End DoDot:1
+11 WRITE !!,"<<If you don't select a sort criteria the report will be sorted by ",$SELECT(ACDPTVS="V":"Visit date",1:"Patient"),".>>"
+12 QUIT
