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
;
;
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>>"
Q
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>>"
Q
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.>>"
Q
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 ;
+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
+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
+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