ASUROTVQ ; IHS/ITSC/LMH -HIGH VAL/QTY ITEM PRINT ;
;;4.2T2;Supply Accounting Mgmt. System;;JUN 30, 2000
;This routine selects Index items which have had the highest value
;total of issues or quantity of issues and prints a list in order
;from highest to lowest for a number of items selected.
Q ;WAR 5/21/99
D ^XBCLS D:'$D(ASUK) ^ASUVAR D:'$D(U) ^XBKVAR D:'$D(IO) HOME^%ZIS
I '$D(^XTMP("ASUTVQ")) D G:$D(DUOUT)!($D(DTOUT)) END
.W "NO DATA EXTRACTED FOR HIGH VALUE / QUANTITY ITEMS REPORT"
.D TVQ0
E D G:$D(DUOUT)!($D(DTOUT)) END
.N DIR
.S DIR(0)="Y",DIR("A")="Do you want to use data from last report" D ^DIR
.Q:Y
.D TVQ0
S X=$G(^XTMP("ASUTVQ")) G:X']"" END
S ASUU("DTFR")=$P(X,U),ASUU("DTFRDS")=$P(X,U,2),ASUU("DTTO")=$P(X,U,3),ASUU("DTTODS")=$P(X,U,4)
S ASUU("ACC")=$P(X,U,5),ASUU("ACC","NM")=$P(X,U,6)
K X
S ASUL(1,"AR","NM")=$G(ASUL(1,"AR","NM"))
I ASUL(1,"AR","NM")']"" K ASUL(1,"AR","AP") D AREA^ASULARST
S ASUL(1,"AR","NM")=$G(ASUL(1,"AR","NM"))
I ASUL(1,"AR","NM")']"" W !,"Unable to determine Area Name" Q
W !!,"You may also choose how many high Value and Quantity items will be on the list",!
S ASUU("TOP")=20
K DIR S DIR(0)="N",DIR("A")="Enter Item Count: ",DIR("B")=ASUU("TOP") D ^DIR
Q:$D(DTOUT) Q:$D(DUOUT)
S ASUU("TOP")=+Y
D O^ASUUZIS
Q:$D(DTOUT) Q:$D(DUOUT)
D U^ASUUZIS
S ASUU("TYPE")="VAL",ASUC("LN")=IOSL+1 D LOOP
S ASUU("TYPE")="QTY",ASUC("LN")=IOSL+1 D LOOP
S ASUU("TYPE")="DEL",ASUU("TOP")=99999,ASUC("LN")=IOSL+1 D LOOP
G END
LOOP ;
S (ASUHDA,ASUU("IDX"))=""
S ASUC("PG")=1,ASUU("HIGH")="",ASUU(1)=1,ASUU("QUIT")=0
F S ASUU("HIGH")=$O(^XTMP("ASUTVQ",ASUU("TYPE"),ASUU("HIGH"))) D LOOP2 Q:ASUU("QUIT")
Q
LOOP2 ;
I ASUU("HIGH")']"" S ASUU("QUIT")=1 Q
I ASUU(1)>ASUU("TOP") S ASUU("QUIT")=1 Q
S ASUU("IDX")=""
F ASUU(1)=ASUU(1):1 S ASUU("IDX")=$O(^XTMP("ASUTVQ",ASUU("TYPE"),ASUU("HIGH"),ASUU("IDX"))) Q:ASUU("IDX")']"" Q:ASUU(1)>ASUU("TOP") D
.I ASUU(1)>ASUU("TOP") S ASUU("QUIT")=1 Q
.I ASUC("LN")>ASUK(ASUK("PTR"),"IOSL") D
..W @ASUK(ASUK("PTR"),"IOF")
..W !,"SAMS LISTING OF TOP ",$S(ASUU("TYPE")="DEL":"ALL ITEMS WHICH HAVE BEEN DELETED",1:ASUU("TOP")_" ITEMS BY "_ASUU("TYPE"))," FOR ACCOUNT ",ASUU("ACC","NM"),?72,"PAGE: ",ASUC("PG")
..W !?10,"FOR REGIONAL SUPPLY SERVICE CENTER -",ASUL(1,"AR","NM")
..W !?10,"FOR DATE RANGE FROM ",ASUU("DTFRDS")," TO ",ASUU("DTTODS")
..S ASUC("LN")=0,ASUC("PG")=ASUC("PG")+1
.S ASUHDA=$O(^ASUMX("B",ASUU("IDX"),""))
.I ASUHDA']"" D Q
..Q:ASUU("TYPE")="DEL"
..S ^XTMP("ASUTVQ","DEL",1,ASUU("IDX"))=^XTMP("ASUTVQ",ASUU("TYPE"),ASUU("HIGH"),ASUU("IDX"))
..S ASUU(1)=ASUU(1) Q
.S ASUV("DESC1")=$P(^ASUMX(ASUHDA,0),U,2)
.S ASUV("DESC2")=$P(^ASUMX(ASUHDA,0),U,3)
.S ASUV("U/I")=$P(^ASUMX(ASUHDA,0),U,4)
.S ASUV("ACC")=$P(^XTMP("ASUTVQ",ASUU("IDX")),U,3)
.S ASUV("QTY")=$P(^XTMP("ASUTVQ",ASUU("IDX")),U,2)
.S ASUV("VAL2")=$P(^XTMP("ASUTVQ",ASUU("IDX")),U)
.S ASUC("LN")=ASUC("LN")+3
.I ASUU("TYPE")="DEL" D
..W !,"INDEX: ",$E(ASUU("IDX"),1,5),".",$E(ASUU("IDX"),6),?16,"QTY: ",$J(ASUV("QTY"),8)
..W ?35,"VALUE: ",$J($FN(ASUV("VAL2"),",",2),15),?72,"ACC: ",ASUV("ACC")
.E D
..W !!,"NO.: ",ASUU(1),?10,ASUV("DESC1")," ",ASUV("DESC2"),?72,"U/I: ",ASUV("U/I")
..W !,"INDEX: ",$E(ASUU("IDX"),1,5),".",$E(ASUU("IDX"),6),?16,"QTY: ",$J(ASUV("QTY"),8)
..W ?35,"VALUE: ",$J($FN(ASUV("VAL2"),",",2),15),?72,"ACC: ",ASUV("ACC")
Q
TVQ0 ;
D ^XBCLS D:'$D(U) ^XBKVAR D:'$D(IO) HOME^%ZIS K ^XTMP("ASUTVQ") S ^XTMP("ASUTVQ",0)=ASUK("DT","FM")+10000_U_ASUK("DT","FM")
S (Y,ASUU("DT"))=2911001 X ^DD("DD") S ASUU("DTFRDS")=Y
W !!,"The Top Value and Quantity report is created for either all accounts ",!,"or for a selected account and by a Date Range",!
K DIR S DIR(0)="Y",DIR("B")="N",DIR("A")="Do you want the report for all Accounts" D ^DIR
I X="Y" D
.S ASUU("ACC")="A",ASUU("ACC","NM")="ALL"
E D
.K DIR S DIR(0)="P^9002039.09",DIR("A")="Enter Account: ",DIR("B")=1 D ^DIR
.Q:$D(DTOUT) Q:$D(DUOUT)
.S ASUU("ACC")=$P(Y,U,2),ASUU("ACC","NM")=$P($G(^ASUL(9,+Y,0)),U,3)
W !!,"You now need to select the Date Range for the Report.",!
K DIR S DIR(0)="D",DIR("A")="Enter Starting Date: ",DIR("B")=ASUU("DTFRDS") D ^DIR
Q:$D(DTOUT) Q:$D(DUOUT)
S (ASUU("DT"),ASUU("DTFR"))=Y X ^DD("DD") S ASUU("DTFRDS")=Y
S (Y,ASUU("DTTO"))=ASUU("DTFR")+10000 X ^DD("DD") S ASUU("DTTODS")=Y
K DIR S DIR(0)="D",DIR("A")="Enter Ending Date: ",DIR("B")=ASUU("DTTODS") D ^DIR
Q:$D(DTOUT) Q:$D(DUOUT)
S ASUU("DTTO")=Y X ^DD("DD") S ASUU("DTTODS")=Y
I ASUU("DTTO")']ASUU("DTFR") W !,"The ending date you selected is not after the beginning date" Q
W !,"EXTRACT DATE RANGE = ",ASUU("DTFR")," THROUGH ",ASUU("DTTO")
S ^XTMP("ASUTVQ")=ASUU("DTFR")_U_ASUU("DTFRDS")_U_ASUU("DTTO")_U_ASUU("DTTODS")_U_ASUU("ACC")_U_ASUU("ACC","NM")
F ASUC=0:1 S ASUU("DT")=$O(^ASUT(3,"AX",ASUU("DT"))) Q:ASUU("DT")>ASUU("DTTO") Q:ASUU("DT")']"" D
.W !,"NOW PROCESSING EXTRACT DATE: ",ASUU("DT")
.S ASUHDA="",ASUC("ACC")=0
.F ASUU(0)=0:1 S ASUHDA=$O(^ASUT(3,"AX",ASUU("DT"),ASUHDA)) Q:ASUHDA']"" D
..D READ^ASU0TRRD(.ASUHDA,"H") Q:$G(ASUT)']""
..I ASUU("ACC")'="A",ASUT(ASUT,"ACC")'=ASUU("ACC") Q
..S ASUC("ACC")=ASUC("ACC")+1
..S ASUV("TVAL")=$P($G(^XTMP("ASUTVQ",ASUT(ASUT,"IDX"))),U)+ASUT(ASUT,"VAL")
..S ASUV("TQTY")=$P($G(^XTMP("ASUTVQ",ASUT(ASUT,"IDX"))),U,2)+ASUT(ASUT,"QTY","ISS")
..S ^XTMP("ASUTVQ",ASUT(ASUT,"IDX"))=ASUV("TVAL")_U_ASUV("TQTY")_U_ASUT(ASUT,"ACC")
.W !,"PROCESSED: ",ASUU(0)," ISSUES "
.W:ASUU("ACC")'="A" ASUC("ACC")," OF WHICH WERE FOR ACCOUNT ",ASUU("ACC","NM")
I ASUC=0 W !,"NO DATA PROCESSED IN SELECTED DATE RANGE",! G END
XREF ;
I '$D(^XTMP("ASUTVQ")) W "NO DATA EXTRACTED FOR HIGH VALUE / QUANTITY ITEMS REPORT" G END
S X=^XTMP("ASUTVQ"),ASUU("DTFR")=$P(X,U),ASUU("DTFRDS")=$P(X,U,2),ASUU("DTTO")=$P(X,U,3),ASUU("DTTODS")=$P(X,U,4),ASUU("ACC")=$P(X,U,5),ASUU("ACC","NM")=$P(X,U,6)
S ASUU("IDX")=""
F S ASUU("IDX")=$O(^XTMP("ASUTVQ",ASUU("IDX"))) Q:ASUU("IDX")'?1N.N D
.S ASUU("VALRV")=$S($P(^XTMP("ASUTVQ",ASUU("IDX")),U)'>0:1,1:1/$P(^XTMP("ASUTVQ",ASUU("IDX")),U))
.S ASUU("QTYRV")=$S($P(^XTMP("ASUTVQ",ASUU("IDX")),U,2)'>0:1,1:1/$P(^XTMP("ASUTVQ",ASUU("IDX")),U,2))
.S ^XTMP("ASUTVQ","QTY",ASUU("QTYRV"),ASUU("IDX"))=""
.S ^XTMP("ASUTVQ","VAL",ASUU("VALRV"),ASUU("IDX"))=""
END ;
D:$D(ASUK("PTR")) C^ASUUZIS
K ASUC,ASU,ASUR,ASUV,ASUK
Q
ASUROTVQ ; IHS/ITSC/LMH -HIGH VAL/QTY ITEM PRINT ;
+1 ;;4.2T2;Supply Accounting Mgmt. System;;JUN 30, 2000
+2 ;This routine selects Index items which have had the highest value
+3 ;total of issues or quantity of issues and prints a list in order
+4 ;from highest to lowest for a number of items selected.
+5 ;WAR 5/21/99
QUIT
+6 DO ^XBCLS
IF '$DATA(ASUK)
DO ^ASUVAR
IF '$DATA(U)
DO ^XBKVAR
IF '$DATA(IO)
DO HOME^%ZIS
+7 IF '$DATA(^XTMP("ASUTVQ"))
Begin DoDot:1
+8 WRITE "NO DATA EXTRACTED FOR HIGH VALUE / QUANTITY ITEMS REPORT"
+9 DO TVQ0
End DoDot:1
IF $DATA(DUOUT)!($DATA(DTOUT))
GOTO END
+10 IF '$TEST
Begin DoDot:1
+11 NEW DIR
+12 SET DIR(0)="Y"
SET DIR("A")="Do you want to use data from last report"
DO ^DIR
+13 IF Y
QUIT
+14 DO TVQ0
End DoDot:1
IF $DATA(DUOUT)!($DATA(DTOUT))
GOTO END
+15 SET X=$GET(^XTMP("ASUTVQ"))
IF X']""
GOTO END
+16 SET ASUU("DTFR")=$PIECE(X,U)
SET ASUU("DTFRDS")=$PIECE(X,U,2)
SET ASUU("DTTO")=$PIECE(X,U,3)
SET ASUU("DTTODS")=$PIECE(X,U,4)
+17 SET ASUU("ACC")=$PIECE(X,U,5)
SET ASUU("ACC","NM")=$PIECE(X,U,6)
+18 KILL X
+19 SET ASUL(1,"AR","NM")=$GET(ASUL(1,"AR","NM"))
+20 IF ASUL(1,"AR","NM")']""
KILL ASUL(1,"AR","AP")
DO AREA^ASULARST
+21 SET ASUL(1,"AR","NM")=$GET(ASUL(1,"AR","NM"))
+22 IF ASUL(1,"AR","NM")']""
WRITE !,"Unable to determine Area Name"
QUIT
+23 WRITE !!,"You may also choose how many high Value and Quantity items will be on the list",!
+24 SET ASUU("TOP")=20
+25 KILL DIR
SET DIR(0)="N"
SET DIR("A")="Enter Item Count: "
SET DIR("B")=ASUU("TOP")
DO ^DIR
+26 IF $DATA(DTOUT)
QUIT
IF $DATA(DUOUT)
QUIT
+27 SET ASUU("TOP")=+Y
+28 DO O^ASUUZIS
+29 IF $DATA(DTOUT)
QUIT
IF $DATA(DUOUT)
QUIT
+30 DO U^ASUUZIS
+31 SET ASUU("TYPE")="VAL"
SET ASUC("LN")=IOSL+1
DO LOOP
+32 SET ASUU("TYPE")="QTY"
SET ASUC("LN")=IOSL+1
DO LOOP
+33 SET ASUU("TYPE")="DEL"
SET ASUU("TOP")=99999
SET ASUC("LN")=IOSL+1
DO LOOP
+34 GOTO END
LOOP ;
+1 SET (ASUHDA,ASUU("IDX"))=""
+2 SET ASUC("PG")=1
SET ASUU("HIGH")=""
SET ASUU(1)=1
SET ASUU("QUIT")=0
+3 FOR
SET ASUU("HIGH")=$ORDER(^XTMP("ASUTVQ",ASUU("TYPE"),ASUU("HIGH")))
DO LOOP2
IF ASUU("QUIT")
QUIT
+4 QUIT
LOOP2 ;
+1 IF ASUU("HIGH")']""
SET ASUU("QUIT")=1
QUIT
+2 IF ASUU(1)>ASUU("TOP")
SET ASUU("QUIT")=1
QUIT
+3 SET ASUU("IDX")=""
+4 FOR ASUU(1)=ASUU(1):1
SET ASUU("IDX")=$ORDER(^XTMP("ASUTVQ",ASUU("TYPE"),ASUU("HIGH"),ASUU("IDX")))
IF ASUU("IDX")']""
QUIT
IF ASUU(1)>ASUU("TOP")
QUIT
Begin DoDot:1
+5 IF ASUU(1)>ASUU("TOP")
SET ASUU("QUIT")=1
QUIT
+6 IF ASUC("LN")>ASUK(ASUK("PTR"),"IOSL")
Begin DoDot:2
+7 WRITE @ASUK(ASUK("PTR"),"IOF")
+8 WRITE !,"SAMS LISTING OF TOP ",$SELECT(ASUU("TYPE")="DEL":"ALL ITEMS WHICH HAVE BEEN DELETED",1:ASUU("TOP")_" ITEMS BY "_ASUU("TYPE"))," FOR ACCOUNT ",ASUU("ACC","NM"),?72,"PAGE: ",ASUC("PG")
+9 WRITE !?10,"FOR REGIONAL SUPPLY SERVICE CENTER -",ASUL(1,"AR","NM")
+10 WRITE !?10,"FOR DATE RANGE FROM ",ASUU("DTFRDS")," TO ",ASUU("DTTODS")
+11 SET ASUC("LN")=0
SET ASUC("PG")=ASUC("PG")+1
End DoDot:2
+12 SET ASUHDA=$ORDER(^ASUMX("B",ASUU("IDX"),""))
+13 IF ASUHDA']""
Begin DoDot:2
+14 IF ASUU("TYPE")="DEL"
QUIT
+15 SET ^XTMP("ASUTVQ","DEL",1,ASUU("IDX"))=^XTMP("ASUTVQ",ASUU("TYPE"),ASUU("HIGH"),ASUU("IDX"))
+16 SET ASUU(1)=ASUU(1)
QUIT
End DoDot:2
QUIT
+17 SET ASUV("DESC1")=$PIECE(^ASUMX(ASUHDA,0),U,2)
+18 SET ASUV("DESC2")=$PIECE(^ASUMX(ASUHDA,0),U,3)
+19 SET ASUV("U/I")=$PIECE(^ASUMX(ASUHDA,0),U,4)
+20 SET ASUV("ACC")=$PIECE(^XTMP("ASUTVQ",ASUU("IDX")),U,3)
+21 SET ASUV("QTY")=$PIECE(^XTMP("ASUTVQ",ASUU("IDX")),U,2)
+22 SET ASUV("VAL2")=$PIECE(^XTMP("ASUTVQ",ASUU("IDX")),U)
+23 SET ASUC("LN")=ASUC("LN")+3
+24 IF ASUU("TYPE")="DEL"
Begin DoDot:2
+25 WRITE !,"INDEX: ",$EXTRACT(ASUU("IDX"),1,5),".",$EXTRACT(ASUU("IDX"),6),?16,"QTY: ",$JUSTIFY(ASUV("QTY"),8)
+26 WRITE ?35,"VALUE: ",$JUSTIFY($FNUMBER(ASUV("VAL2"),",",2),15),?72,"ACC: ",ASUV("ACC")
End DoDot:2
+27 IF '$TEST
Begin DoDot:2
+28 WRITE !!,"NO.: ",ASUU(1),?10,ASUV("DESC1")," ",ASUV("DESC2"),?72,"U/I: ",ASUV("U/I")
+29 WRITE !,"INDEX: ",$EXTRACT(ASUU("IDX"),1,5),".",$EXTRACT(ASUU("IDX"),6),?16,"QTY: ",$JUSTIFY(ASUV("QTY"),8)
+30 WRITE ?35,"VALUE: ",$JUSTIFY($FNUMBER(ASUV("VAL2"),",",2),15),?72,"ACC: ",ASUV("ACC")
End DoDot:2
End DoDot:1
+31 QUIT
TVQ0 ;
+1 DO ^XBCLS
IF '$DATA(U)
DO ^XBKVAR
IF '$DATA(IO)
DO HOME^%ZIS
KILL ^XTMP("ASUTVQ")
SET ^XTMP("ASUTVQ",0)=ASUK("DT","FM")+10000_U_ASUK("DT","FM")
+2 SET (Y,ASUU("DT"))=2911001
XECUTE ^DD("DD")
SET ASUU("DTFRDS")=Y
+3 WRITE !!,"The Top Value and Quantity report is created for either all accounts ",!,"or for a selected account and by a Date Range",!
+4 KILL DIR
SET DIR(0)="Y"
SET DIR("B")="N"
SET DIR("A")="Do you want the report for all Accounts"
DO ^DIR
+5 IF X="Y"
Begin DoDot:1
+6 SET ASUU("ACC")="A"
SET ASUU("ACC","NM")="ALL"
End DoDot:1
+7 IF '$TEST
Begin DoDot:1
+8 KILL DIR
SET DIR(0)="P^9002039.09"
SET DIR("A")="Enter Account: "
SET DIR("B")=1
DO ^DIR
+9 IF $DATA(DTOUT)
QUIT
IF $DATA(DUOUT)
QUIT
+10 SET ASUU("ACC")=$PIECE(Y,U,2)
SET ASUU("ACC","NM")=$PIECE($GET(^ASUL(9,+Y,0)),U,3)
End DoDot:1
+11 WRITE !!,"You now need to select the Date Range for the Report.",!
+12 KILL DIR
SET DIR(0)="D"
SET DIR("A")="Enter Starting Date: "
SET DIR("B")=ASUU("DTFRDS")
DO ^DIR
+13 IF $DATA(DTOUT)
QUIT
IF $DATA(DUOUT)
QUIT
+14 SET (ASUU("DT"),ASUU("DTFR"))=Y
XECUTE ^DD("DD")
SET ASUU("DTFRDS")=Y
+15 SET (Y,ASUU("DTTO"))=ASUU("DTFR")+10000
XECUTE ^DD("DD")
SET ASUU("DTTODS")=Y
+16 KILL DIR
SET DIR(0)="D"
SET DIR("A")="Enter Ending Date: "
SET DIR("B")=ASUU("DTTODS")
DO ^DIR
+17 IF $DATA(DTOUT)
QUIT
IF $DATA(DUOUT)
QUIT
+18 SET ASUU("DTTO")=Y
XECUTE ^DD("DD")
SET ASUU("DTTODS")=Y
+19 IF ASUU("DTTO")']ASUU("DTFR")
WRITE !,"The ending date you selected is not after the beginning date"
QUIT
+20 WRITE !,"EXTRACT DATE RANGE = ",ASUU("DTFR")," THROUGH ",ASUU("DTTO")
+21 SET ^XTMP("ASUTVQ")=ASUU("DTFR")_U_ASUU("DTFRDS")_U_ASUU("DTTO")_U_ASUU("DTTODS")_U_ASUU("ACC")_U_ASUU("ACC","NM")
+22 FOR ASUC=0:1
SET ASUU("DT")=$ORDER(^ASUT(3,"AX",ASUU("DT")))
IF ASUU("DT")>ASUU("DTTO")
QUIT
IF ASUU("DT")']""
QUIT
Begin DoDot:1
+23 WRITE !,"NOW PROCESSING EXTRACT DATE: ",ASUU("DT")
+24 SET ASUHDA=""
SET ASUC("ACC")=0
+25 FOR ASUU(0)=0:1
SET ASUHDA=$ORDER(^ASUT(3,"AX",ASUU("DT"),ASUHDA))
IF ASUHDA']""
QUIT
Begin DoDot:2
+26 DO READ^ASU0TRRD(.ASUHDA,"H")
IF $GET(ASUT)']""
QUIT
+27 IF ASUU("ACC")'="A"
IF ASUT(ASUT,"ACC")'=ASUU("ACC")
QUIT
+28 SET ASUC("ACC")=ASUC("ACC")+1
+29 SET ASUV("TVAL")=$PIECE($GET(^XTMP("ASUTVQ",ASUT(ASUT,"IDX"))),U)+ASUT(ASUT,"VAL")
+30 SET ASUV("TQTY")=$PIECE($GET(^XTMP("ASUTVQ",ASUT(ASUT,"IDX"))),U,2)+ASUT(ASUT,"QTY","ISS")
+31 SET ^XTMP("ASUTVQ",ASUT(ASUT,"IDX"))=ASUV("TVAL")_U_ASUV("TQTY")_U_ASUT(ASUT,"ACC")
End DoDot:2
+32 WRITE !,"PROCESSED: ",ASUU(0)," ISSUES "
+33 IF ASUU("ACC")'="A"
WRITE ASUC("ACC")," OF WHICH WERE FOR ACCOUNT ",ASUU("ACC","NM")
End DoDot:1
+34 IF ASUC=0
WRITE !,"NO DATA PROCESSED IN SELECTED DATE RANGE",!
GOTO END
XREF ;
+1 IF '$DATA(^XTMP("ASUTVQ"))
WRITE "NO DATA EXTRACTED FOR HIGH VALUE / QUANTITY ITEMS REPORT"
GOTO END
+2 SET X=^XTMP("ASUTVQ")
SET ASUU("DTFR")=$PIECE(X,U)
SET ASUU("DTFRDS")=$PIECE(X,U,2)
SET ASUU("DTTO")=$PIECE(X,U,3)
SET ASUU("DTTODS")=$PIECE(X,U,4)
SET ASUU("ACC")=$PIECE(X,U,5)
SET ASUU("ACC","NM")=$PIECE(X,U,6)
+3 SET ASUU("IDX")=""
+4 FOR
SET ASUU("IDX")=$ORDER(^XTMP("ASUTVQ",ASUU("IDX")))
IF ASUU("IDX")'?1N.N
QUIT
Begin DoDot:1
+5 SET ASUU("VALRV")=$SELECT($PIECE(^XTMP("ASUTVQ",ASUU("IDX")),U)'>0:1,1:1/$PIECE(^XTMP("ASUTVQ",ASUU("IDX")),U))
+6 SET ASUU("QTYRV")=$SELECT($PIECE(^XTMP("ASUTVQ",ASUU("IDX")),U,2)'>0:1,1:1/$PIECE(^XTMP("ASUTVQ",ASUU("IDX")),U,2))
+7 SET ^XTMP("ASUTVQ","QTY",ASUU("QTYRV"),ASUU("IDX"))=""
+8 SET ^XTMP("ASUTVQ","VAL",ASUU("VALRV"),ASUU("IDX"))=""
End DoDot:1
END ;
+1 IF $DATA(ASUK("PTR"))
DO C^ASUUZIS
+2 KILL ASUC,ASU,ASUR,ASUV,ASUK
+3 QUIT
