Routine: ACDRL2

ACDRL2 ;IHS/ADC/EDE/KML - CONT OF ACDRL;

 ;;4.1;CHEMICAL DEPENDENCY MIS;;MAY 11, 1998

PMENU ;EP

 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>>"

SMENU ;EP

 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>>"

RMENU ;EP - SORT MENU

 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"),".>>"

ACDRL2    ;IHS/ADC/EDE/KML - CONT OF ACDRL;

 +1       ;;4.1;CHEMICAL DEPENDENCY MIS;;MAY 11, 1998

 +2       ;

 +3       ;

PMENU     ;EP

 +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

SMENU     ;EP

 +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

RMENU     ;EP - SORT MENU

 +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

ACDRL2.m