- 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
