Routine: ACMRL2

ACMRL2 ; IHS/TUCSON/TMJ - CONT OF ACMRL ; [ 06/01/1999  1:37 PM ]

 ;;2.0;ACM CASE MANAGEMENT SYSTEM;**1**;JAN 10, 1996

 ;IHS/CMI/LAB - patch 1 - flat file, tmp to xtmp

PMENU ;EP

 K ACMDISP,ACMSEL,ACMHIGH

 W:$D(IOF) @IOF

 W !,"REGISTER:  ",$P(^ACM(41.1,ACMRG,0),U),"     USER:  ",$E($P(^VA(200,DUZ,0),U),1,15),!

 S ACMLHDR="PRINT Data Items Menu" W ?((80-$L(ACMLHDR))/2),ACMLHDR,!

 I ACMCTYP="P" 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.",! ;IHS/CMI/LAB

 I ACMCTYP="F" W "The following data items can be selected to be output to a '^' delimited file.",!,"Choose the data items in the order you want them to be output.",! ;IHS/CMI/LAB

 I ACMCTYP="P" W ?15,"Total Report width (including column margins - 2 spaces):   ",ACMTCW

 S ACMHIGH=0,X=0 F  S X=$O(^ACM(58.1,"C",X)) Q:X'=+X  S Y=$O(^ACM(58.1,"C",X,"")) D

 .I $P(^ACM(58.1,Y,0),U,5)'["P" Q

 .I $P(^ACM(58.1,Y,0),U,11)]"",ACMCTRLP'[$P(^(0),U,11) Q

 .I $P(^ACM(58.1,Y,0),U,8),ACMCTYP="F" Q  ;IHS/CMI/LAB - no mult valued items for now

 .S ACMHIGH=ACMHIGH+1,ACMSEL(ACMHIGH)=Y

.Q

 S ACMCUT=((ACMHIGH/3)+1)\1

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

 .W !,I,")  ",$S($P(^ACM(58.1,ACMSEL(I),0),U,12)="":$E($P(^(0),U),1,20),1:$P(^(0),U,12)) S ACMDISP(I)=""

 .S J=I+ACMCUT I $D(ACMSEL(J)),'$D(ACMDISP(J)) W ?26,J,")  ",$S($P(^ACM(58.1,ACMSEL(J),0),U,12)="":$E($P(^ACM(58.1,ACMSEL(J),0),U),1,20),1:$P(^(0),U,12)) S ACMDISP(J)=""

 .S K=J+ACMCUT I $D(ACMSEL(K)),'$D(ACMDISP(K)) W ?53,K,")  ",$S($P(^ACM(58.1,ACMSEL(K),0),U,12)="":$E($P(^ACM(58.1,ACMSEL(K),0),U),1,20),1:$P(^(0),U,12)) S ACMDISP(K)=""

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

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

SMENU ;EP

 K ACMDISP,ACMSEL,ACMHIGH

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

 W:$D(IOF) @IOF

 W !,"REGISTER:  ",$P(^ACM(41.1,ACMRG,0),U),"     USER:  ",$E($P(^VA(200,DUZ,0),U),1,15)

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

 S ACMHIGH=0,X=0 F  S X=$O(^ACM(58.1,"C",X)) Q:X'=+X  S Y=$O(^ACM(58.1,"C",X,"")) D

 .I $P(^ACM(58.1,Y,0),U,5)'["S" Q

 .I $P(^ACM(58.1,Y,0),U,11)]"",ACMCTRLP'[$P(^(0),U,11) Q

 .S ACMHIGH=ACMHIGH+1,ACMSEL(ACMHIGH)=Y

.Q

 S ACMCUT=((ACMHIGH/3)+1)\1

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

 .W !,I,")  ",$S($P(^ACM(58.1,ACMSEL(I),0),U,12)="":$E($P(^(0),U),1,20),1:$P(^(0),U,12)) S ACMDISP(I)=""

 .S J=I+ACMCUT I $D(ACMSEL(J)),'$D(ACMDISP(J)) W ?28,J,")  ",$S($P(^ACM(58.1,ACMSEL(J),0),U,12)="":$E($P(^ACM(58.1,ACMSEL(J),0),U),1,20),1:$P(^(0),U,12)) S ACMDISP(J)=""

 .S K=J+ACMCUT I $D(ACMSEL(K)),'$D(ACMDISP(K)) W ?55,K,")  ",$S($P(^ACM(58.1,ACMSEL(K),0),U,12)="":$E($P(^ACM(58.1,ACMSEL(K),0),U),1,20),1:$P(^(0),U,12)) S ACMDISP(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 ACMDISP,ACMSEL,ACMHIGH

 W:$D(IOF) @IOF

 W !,"REGISTER:  ",$P(^ACM(41.1,ACMRG,0),U),"     USER:  ",$E($P(^VA(200,DUZ,0),U),1,15)

 W !!,"The Patients displayed can be SORTED by any one of the following:",!

 S ACMHIGH=0,X=0 F  S X=$O(^ACM(58.1,X)) Q:X'=+X  I $P(^ACM(58.1,X,0),U,5)["R" S ACMHIGH=ACMHIGH+1,ACMSEL(ACMHIGH)=X

 S ACMCUT=((ACMHIGH/2)+1)\1

 S I=0,J=1,K=1 F  S I=$O(ACMSEL(I)) Q:I'=+I!($D(ACMDISP(I)))  W !?5,I,")  ",$P(^ACM(58.1,ACMSEL(I),0),U) S ACMDISP(I)="",J=I+ACMCUT I $D(ACMSEL(J)),'$D(ACMDISP(J)) W ?40,J,")  ",$P(^ACM(58.1,ACMSEL(J),0),U) S ACMDISP(J)=""

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

ACMRL2    ; IHS/TUCSON/TMJ - CONT OF ACMRL ; [ 06/01/1999  1:37 PM ]

 +1       ;;2.0;ACM CASE MANAGEMENT SYSTEM;**1**;JAN 10, 1996

 +2       ;IHS/CMI/LAB - patch 1 - flat file, tmp to xtmp

 +3       ;

 +4       ;

PMENU     ;EP

 +1        KILL ACMDISP,ACMSEL,ACMHIGH

 +2        IF $DATA(IOF)

               WRITE @IOF

 +3        WRITE !,"REGISTER:  ",$PIECE(^ACM(41.1,ACMRG,0),U),"     USER:  ",$EXTRACT($PIECE(^VA(200,DUZ,0),U),1,15),!

 +4        SET ACMLHDR="PRINT Data Items Menu"

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

 +5       ;IHS/CMI/LAB

           IF ACMCTYP="P"

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

 +6       ;IHS/CMI/LAB

           IF ACMCTYP="F"

               WRITE "The following data items can be selected to be output to a '^' delimited file.",!,"Choose the data items in the order you want them to be output.",!

 +7        IF ACMCTYP="P"

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

 +8        SET ACMHIGH=0

           SET X=0

FOR

               SET X=$ORDER(^ACM(58.1,"C",X))

               IF X'=+X

                   QUIT

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

               Begin DoDot:1

 +9                IF $PIECE(^ACM(58.1,Y,0),U,5)'["P"

                       QUIT

 +10               IF $PIECE(^ACM(58.1,Y,0),U,11)]""

                       IF ACMCTRLP'[$PIECE(^(0),U,11)

                           QUIT

 +11      ;IHS/CMI/LAB - no mult valued items for now

                   IF $PIECE(^ACM(58.1,Y,0),U,8)

                       IF ACMCTYP="F"

                           QUIT

 +12               SET ACMHIGH=ACMHIGH+1

                   SET ACMSEL(ACMHIGH)=Y

 +13               QUIT

               End DoDot:1

 +14       SET ACMCUT=((ACMHIGH/3)+1)\1

 +15       SET I=0

           SET J=1

           SET K=1

FOR

               SET I=$ORDER(ACMSEL(I))

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

                   QUIT

               Begin DoDot:1

 +16               WRITE !,I,")  ",$SELECT($PIECE(^ACM(58.1,ACMSEL(I),0),U,12)="":$EXTRACT($PIECE(^(0),U),1,20),1:$PIECE(^(0),U,12))

                   SET ACMDISP(I)=""

 +17               SET J=I+ACMCUT

                   IF $DATA(ACMSEL(J))

                       IF '$DATA(ACMDISP(J))

                           WRITE ?26,J,")  ",$SELECT($PIECE(^ACM(58.1,ACMSEL(J),0),U,12)="":$EXTRACT($PIECE(^ACM(58.1,ACMSEL(J),0),U),1,20),1:$PIECE(^(0),U,12))

                           SET ACMDISP(J)=""

 +18               SET K=J+ACMCUT

                   IF $DATA(ACMSEL(K))

                       IF '$DATA(ACMDISP(K))

                           WRITE ?53,K,")  ",$SELECT($PIECE(^ACM(58.1,ACMSEL(K),0),U,12)="":$EXTRACT($PIECE(^ACM(58.1,ACMSEL(K),0),U),1,20),1:$PIECE(^(0),U,12))

                           SET ACMDISP(K)=""

               End DoDot:1

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

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

 +21       QUIT

SMENU     ;EP

 +1        KILL ACMDISP,ACMSEL,ACMHIGH

 +2        IF $Y>(IOSL-4)

               IF $DATA(IOF)

                   WRITE @IOF

 +3        IF $DATA(IOF)

               WRITE @IOF

 +4        WRITE !,"REGISTER:  ",$PIECE(^ACM(41.1,ACMRG,0),U),"     USER:  ",$EXTRACT($PIECE(^VA(200,DUZ,0),U),1,15)

 +5        WRITE !!,"The Patients displayed can be SEARCHED based on any of the following criteria:",!

 +6        SET ACMHIGH=0

           SET X=0

FOR

               SET X=$ORDER(^ACM(58.1,"C",X))

               IF X'=+X

                   QUIT

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

               Begin DoDot:1

 +7                IF $PIECE(^ACM(58.1,Y,0),U,5)'["S"

                       QUIT

 +8                IF $PIECE(^ACM(58.1,Y,0),U,11)]""

                       IF ACMCTRLP'[$PIECE(^(0),U,11)

                           QUIT

 +9                SET ACMHIGH=ACMHIGH+1

                   SET ACMSEL(ACMHIGH)=Y

 +10               QUIT

               End DoDot:1

 +11       SET ACMCUT=((ACMHIGH/3)+1)\1

 +12       SET I=0

           SET J=1

           SET K=1

FOR

               SET I=$ORDER(ACMSEL(I))

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

                   QUIT

               Begin DoDot:1

 +13               WRITE !,I,")  ",$SELECT($PIECE(^ACM(58.1,ACMSEL(I),0),U,12)="":$EXTRACT($PIECE(^(0),U),1,20),1:$PIECE(^(0),U,12))

                   SET ACMDISP(I)=""

 +14               SET J=I+ACMCUT

                   IF $DATA(ACMSEL(J))

                       IF '$DATA(ACMDISP(J))

                           WRITE ?28,J,")  ",$SELECT($PIECE(^ACM(58.1,ACMSEL(J),0),U,12)="":$EXTRACT($PIECE(^ACM(58.1,ACMSEL(J),0),U),1,20),1:$PIECE(^(0),U,12))

                           SET ACMDISP(J)=""

 +15               SET K=J+ACMCUT

                   IF $DATA(ACMSEL(K))

                       IF '$DATA(ACMDISP(K))

                           WRITE ?55,K,")  ",$SELECT($PIECE(^ACM(58.1,ACMSEL(K),0),U,12)="":$EXTRACT($PIECE(^ACM(58.1,ACMSEL(K),0),U),1,20),1:$PIECE(^(0),U,12))

                           SET ACMDISP(K)=""

               End DoDot:1

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

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

 +18       QUIT

RMENU     ;EP - SORT MENU

 +1        KILL ACMDISP,ACMSEL,ACMHIGH

 +2        IF $DATA(IOF)

               WRITE @IOF

 +3        WRITE !,"REGISTER:  ",$PIECE(^ACM(41.1,ACMRG,0),U),"     USER:  ",$EXTRACT($PIECE(^VA(200,DUZ,0),U),1,15)

 +4        WRITE !!,"The Patients displayed can be SORTED by any one of the following:",!

 +5        SET ACMHIGH=0

           SET X=0

FOR

               SET X=$ORDER(^ACM(58.1,X))

               IF X'=+X

                   QUIT

               IF $PIECE(^ACM(58.1,X,0),U,5)["R"

                   SET ACMHIGH=ACMHIGH+1

                   SET ACMSEL(ACMHIGH)=X

 +6        SET ACMCUT=((ACMHIGH/2)+1)\1

 +7        SET I=0

           SET J=1

           SET K=1

FOR

               SET I=$ORDER(ACMSEL(I))

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

                   QUIT

               WRITE !?5,I,")  ",$PIECE(^ACM(58.1,ACMSEL(I),0),U)

               SET ACMDISP(I)=""

               SET J=I+ACMCUT

               IF $DATA(ACMSEL(J))

                   IF '$DATA(ACMDISP(J))

                       WRITE ?40,J,")  ",$PIECE(^ACM(58.1,ACMSEL(J),0),U)

                       SET ACMDISP(J)=""

 +8        WRITE !!,"<<If you don't select a sort criteria the report will be sorted by Patient Name.>>"

 +9        QUIT

ACMRL2.m