ASURM23P ; IHS/ITSC/LMH -RPT 23 LIST OVERSTOCK/INACTV ;
;;4.2T2;Supply Accounting Mgmt. System;;JUN 30, 2000
;This routine formats and prints report 23, List Overstocked and
;Inactive Items from sorted extracts.
EN ;EP;PRIMARY ENTRY POINT FOR REPORT 21
I '$D(IO) D HOME^%ZIS
I '$D(DUZ(2)) W !,"Report must be run from Kernel option" Q
I '$D(ASUL(1,"AR","AP")) D SETAREA^ASULARST
S ASUK("PTRSEL")=$G(ASUK("PTRSEL")) I ASUK("PTRSEL")]"" G PSER
S ZTRTN="PSER^ASUD23P",ZTDESC="SAMS RPT 23" D O^ASUUZIS
I POP S IOP=$I D ^%ZIS Q
I ASUK(ASUK("PTR"),"Q") Q
PSER ;EP;FOR TASKMAN QUEUE OF PRINT
N X,Y,Z
D:'$D(^XTMP("ASUR","R23")) SORT
Q:$O(^XTMP("ASUR","R23",0))="" ;WAR 10/1/99 no data for Dir Issue
D U^ASUUZIS
S (ASUC("PG"),ASUMS("E#","ARE"))=0
S ASUMS("E#","ARE")=$O(^XTMP("ASUR","R23",0)) D ARE^ASULARST($E(ASUMS("E#","ARE"),1,2))
S ASURX("ACC")=$O(^XTMP("ASUR","R23",ASUMS("E#","ARE"),0)) D ACC^ASULDIRF(ASURX("ACC")),ACCTGP
S ASUV("RPT")="R23",ASUQ("HDR")="HEADER^ASURM23P"
D ^ASUUDATA I ASUX("NDTA") G K
S (ASUC("PG"),ASUMS("E#","ARE"))=0
F S ASUMS("E#","ARE")=$O(^XTMP("ASUR","R23",ASUMS("E#","ARE"))) Q:ASUMS("E#","ARE")']"" D Q:$D(DUOUT) Q:$D(DTOUT)
.D ARE^ASULARST($E(ASUMS("E#","ARE"),1,2))
.S ASURX("ACC")=0
.F S ASURX("ACC")=$O(^XTMP("ASUR","R23",ASUMS("E#","ARE"),ASURX("ACC"))) Q:ASURX("ACC")']"" D Q:$D(DUOUT) Q:$D(DTOUT)
..D ACC^ASULDIRF(ASURX("ACC")),ACCTGP
..S ASUV("ACCGP")=$G(ASUL(9,"ACC","GP"))
..S ASUMS("E#","IDX")=0
..D:ASUC("LINE")>(IOSL-2) HEADER Q:$D(DTOUT) Q:$D(DUOUT)
..F S ASUMS("E#","IDX")=$O(^XTMP("ASUR","R23",ASUMS("E#","ARE"),ASURX("ACC"),ASUMS("E#","IDX"))) Q:ASUMS("E#","IDX")']"" D Q:$D(DUOUT) Q:$D(DTOUT)
...S ASUMX("E#","IDX")=ASUMS("E#","IDX")
...D READ^ASUMXDIO
...W !?2,$E(ASUMX("IDX"),1,5),".",$E(ASUMX("IDX"),6),?15,ASUMX("DESC",1)," ",ASUMX("DESC",2),?85,ASUMX("AR U/I")
...S ASUC("LINE")=ASUC("LINE")+2
...S ASUMS("E#","STA")=0
...F S ASUMS("E#","STA")=$O(^XTMP("ASUR","R23",ASUMS("E#","ARE"),ASURX("ACC"),ASUMS("E#","IDX"),ASUMS("E#","STA"))) Q:ASUMS("E#","STA")']"" D Q:$D(DUOUT) Q:$D(DTOUT)
....S ASUX(0)=^XTMP("ASUR","R23",ASUMS("E#","ARE"),ASURX("ACC"),ASUMS("E#","IDX"),ASUMS("E#","STA"))
....S ASUC(0,0,"QTY")=$P(ASUX(0),U),ASUV("AST")=$P(ASUX(0),U,2)
....D STA^ASULARST(ASUMS("E#","STA")),^ASUMSTRD
....S ASUC(1,ASUMS("E#","STA"))=$E(ASUL(2,"STA","NM"),1,22)
....W !?4,$E(ASUL(2,"STA","NM"),1,22),?26,ASUMS("SLC")
....D NSNFMT W ?28,ASUV("NSN"),?48,ASUMS("VENAM"),?65,ASUMS("EOQ","TP")
....W ?68,$J($FN(ASUC(0,0,"QTY"),","),7),ASUV("AST"),?80,$J($FN(ASUMS("CST/U"),",",2),8)
....S ASUC(0,0,"VAL")=(ASUC(0,0,"QTY")*(+ASUMS("CST/U")))
....W ?90,$J($FN(ASUC(0,0,"VAL"),",",2),10),?101,$G(ASUL(2,"STA","CTP")),?116,$G(ASUL(2,"STA","TP#"))
....S ASUC("LINE")=ASUC("LINE")+1
....S ASUC(0,0,"LI")=1
....S ASUV("STA")=ASUMS("E#","STA") D ROLL(0)
...Q:$D(DTOUT) Q:$D(DUOUT)
...D STALOOP(0,"ITEM") Q:$D(DTOUT) Q:$D(DUOUT)
...D:ASUC("LINE")>(IOSL-2) HEADER
..Q:$D(DTOUT) Q:$D(DUOUT)
..W !! S Y="ACCOUNT "_ASUV("ACCGP") D STALOOP(1,Y) Q:$D(DTOUT) Q:$D(DUOUT)
..D HEADER Q:$D(DUOUT) Q:$D(DTOUT)
.Q:$D(DTOUT) Q:$D(DUOUT)
.W !!! S Y="AREA "_ASUL(1,"AR","NM") D STALOOP(2,Y) Q:$D(DTOUT) Q:$D(DUOUT)
.S ASUC("LINE")=IOSL
K ;
D PAZ^ASUURHDR I ASUK("PTRSEL")']"" D
.D C^ASUUZIS
K ASUMX,ASUMS,ASURX,ASUX,ASUC
Q
ACCTGP ;
S ASUL(9,"ACC","GP")=$S(ASURX("ACC")=1:ASUL(9,"ACC","NM"),ASURX("ACC")=3:ASUL(9,"ACC","NM"),1:"GENERAL SUPPLIES")
S ASUV("PRTACC")=$S(ASUL(9,"ACC","GP")="GENERAL SUPPLIES":"*",1:ASURX("ACC"))
Q
NSNFMT ;
I ASUMS("ORD#")]"" D
.I $E(ASUMS("ORD#"))="M" S ASUV("NSN")=ASUMS("ORD#") Q
.I ASUMS("ORD#")]"" S ASUV("NSN")=ASUMS("ORD#")
.E S ASUV("NSN")=ASUMX("NSN")
.I $L(ASUV("NSN"))=4 Q
.S ASUV("NSN")=$E(ASUV("NSN"),1,4)_"-"_$E(ASUV("NSN"),5,$L(ASUV("NSN")))
.I $L(ASUV("NSN"))>7 S ASUV("NSN")=$E(ASUV("NSN"),1,7)_"-"_$E(ASUV("NSN"),8,$L(ASUV("NSN")))
.I $L(ASUV("NSN"))>11 S ASUV("NSN")=$E(ASUV("NSN"),1,11)_"-"_$E(ASUV("NSN"),12,$L(ASUV("NSN")))
Q
N X,Y
S ASUC("PG")=$G(ASUC("PG"))+1,ASUC("LINE")=6
I ASUC("PG")>1 D PAZ^ASUURHDR
Q:$D(DTOUT) Q:$D(DUOUT)
W @(IOF),"REPORT #23 LISTING OF OVERSTOCKED SUPPLIES",?90,ASUK("DT"),?110,"PAGE",?115,$J($FN(ASUC("PG"),","),7)
W !,"AREA",?6,ASUL(1,"AR","AP"),?9,ASUL(1,"AR","NM")
W !,?50,"G L ACCOUNT 125.",ASUV("PRTACC"),?68,ASUL(9,"ACC","GP"),!
W !?4,"INDEX",?20,"DESCRIPTION",?84,"UI"
W !?6,"STATION",?25,"SLC",?29,"ORDER NUMBER",?50,"VENDOR NAME",?65,"TC",?70,"QTY",?83,"U/COST",?93,"T-VALUE",?101,"CONTACT PERSON TELEPHONE #",!
Q
STALOOP(X,Y) ;
S ASUV("STA")=""
F ASUC=1:1 S ASUV("STA")=$O(ASUC(X,ASUV("STA"))) Q:ASUV("STA")']"" D Q:$D(DUOUT) Q:$D(DTOUT)
.I ASUC'>1 W !?20,"STATIONS TOTALS FOR ",Y S ASUC("LINE")=$G(ASUC("LINE"))+1 I X>0 W ! S ASUC("LINE")=$G(ASUC("LINE"))+2
.I X>0 D
..D ROLL(X)
..W ?30,ASUC(X,ASUV("STA"))
..W ?68,$J($FN(ASUC(X,ASUV("STA"),"QTY"),","),7),?90,$J($FN(ASUC(X,ASUV("STA"),"VAL"),",",2),10),?105,"LI - ",$J($FN($G(ASUC(X,ASUV("STA"),"LI")),","),8),!
..S ASUC("LINE")=$G(ASUC("LINE"))+1
.S ASUC("TQTY")=$G(ASUC("TQTY"))+ASUC(X,ASUV("STA"),"QTY")
.S ASUC("TVAL")=$G(ASUC("TVAL"))+ASUC(X,ASUV("STA"),"VAL")
.S ASUC("TLI")=$G(ASUC("TLI"))+ASUC(X,ASUV("STA"),"LI")
.K ASUC(X,ASUV("STA"))
W ?68,"_______ __________"
W:X>0 ?110,"________"
W !?68,$J($FN(ASUC("TQTY"),","),7),?90,$J($FN(ASUC("TVAL"),",",2),10)
I X>0 W ?110,$J($FN($G(ASUC("TLI")),","),8)
W !
D:ASUC("LINE")>(IOSL-2) HEADER
Q:$D(DTOUT) Q:$D(DUOUT)
K ASUC("TQTY"),ASUC("TVAL")
S ASUC("LINE")=$G(ASUC("LINE"))+2
Q
ROLL(X) ;
S ASUV("STF")=$S(X=0:0,1:ASUV("STA"))
I X>0 S ASUC(X+1,ASUV("STA"))=ASUC(X,ASUV("STF"))
S ASUC(X+1,ASUV("STA"),"QTY")=$G(ASUC(X+1,ASUV("STA"),"QTY"))+$G(ASUC(X,ASUV("STF"),"QTY"))
S ASUC(X+1,ASUV("STA"),"VAL")=$G(ASUC(X+1,ASUV("STA"),"VAL"))+$G(ASUC(X,ASUV("STF"),"VAL"))
S ASUC(X+1,ASUV("STA"),"LI")=$G(ASUC(X+1,ASUV("STA"),"LI"))+$G(ASUC(X,ASUV("STF"),"LI"))
Q
SORT ;EP ;
K ^XTMP("ASUR","R23")
S ^XTMP("ASUR","R23",0)=ASUK("DT","FM")+10000_U_ASUK("DT","FM")
S ASUMS("E#","STA")=0
F S ASUMS("E#","STA")=$O(^ASUMS(ASUMS("E#","STA"))) Q:ASUMS("E#","STA")'?1N.N D
.F ASUMS("E#","IDX")=0:0 S ASUMS("E#","IDX")=$O(^ASUMS(ASUMS("E#","STA"),1,ASUMS("E#","IDX"))) Q:ASUMS("E#","IDX")'?1N.N D
..S ASUMS("LSTISS")=$P(^ASUMS(ASUMS("E#","STA"),1,ASUMS("E#","IDX"),0),U,13)
..S ASUV("LIMOS")=$E(ASUK("DT","FM"),1,5)-$E(ASUMS("LSTISS"),1,5)
..D ^ASUMSTRD
..Q:ASUMS("QTY","O/H")'>0
..S ASUMX("ACC")=$P($G(^ASUMX(ASUMS("E#","IDX"),0)),U,6)
..Q:ASUMX("ACC")']""
..S ASUMX("ACCTYP")=$S(ASUMX("ACC")=1:1,ASUMX("ACC")=3:3,1:4)
..I ASUV("LIMOS")>12 D
...S ASUC(0,0,"QTY")=ASUMS("QTY","O/H"),ASUV("AST")="*"
..E D Q:ASUC(0,0,"QTY")']""
...I "PN"[ASUMS("EOQ","TP") S ASUC(0,0,"QTY")="" Q
...S ASUV("QTYNEED")=(ASUMS("PMIQ")*12)+ASUMS("RPQ"),ASUC(0,0,"QTY")=ASUMS("QTY","O/H")-ASUV("QTYNEED")
...I ASUC(0,0,"QTY")<1 S ASUC(0,0,"QTY")="" Q
...S ASUV("AST")=""
..S ASUMS("E#","ARE")=$E(ASUMS("E#","STA"),1,2)
..S ^XTMP("ASUR","R23",ASUMS("E#","ARE"),ASUMX("ACCTYP"),ASUMS("E#","IDX"),ASUMS("E#","STA"))=ASUC(0,0,"QTY")_U_ASUV("AST")
Q
ASURM23P ; IHS/ITSC/LMH -RPT 23 LIST OVERSTOCK/INACTV ;
+1 ;;4.2T2;Supply Accounting Mgmt. System;;JUN 30, 2000
+2 ;This routine formats and prints report 23, List Overstocked and
+3 ;Inactive Items from sorted extracts.
EN ;EP;PRIMARY ENTRY POINT FOR REPORT 21
+1 IF '$DATA(IO)
DO HOME^%ZIS
+2 IF '$DATA(DUZ(2))
WRITE !,"Report must be run from Kernel option"
QUIT
+3 IF '$DATA(ASUL(1,"AR","AP"))
DO SETAREA^ASULARST
+4 SET ASUK("PTRSEL")=$GET(ASUK("PTRSEL"))
IF ASUK("PTRSEL")]""
GOTO PSER
+5 SET ZTRTN="PSER^ASUD23P"
SET ZTDESC="SAMS RPT 23"
DO O^ASUUZIS
+6 IF POP
SET IOP=$IO
DO ^%ZIS
QUIT
+7 IF ASUK(ASUK("PTR"),"Q")
QUIT
PSER ;EP;FOR TASKMAN QUEUE OF PRINT
+1 NEW X,Y,Z
+2 IF '$DATA(^XTMP("ASUR","R23"))
DO SORT
+3 ;WAR 10/1/99 no data for Dir Issue
IF $ORDER(^XTMP("ASUR","R23",0))=""
QUIT
+4 DO U^ASUUZIS
+5 SET (ASUC("PG"),ASUMS("E#","ARE"))=0
+6 SET ASUMS("E#","ARE")=$ORDER(^XTMP("ASUR","R23",0))
DO ARE^ASULARST($EXTRACT(ASUMS("E#","ARE"),1,2))
+7 SET ASURX("ACC")=$ORDER(^XTMP("ASUR","R23",ASUMS("E#","ARE"),0))
DO ACC^ASULDIRF(ASURX("ACC"))
DO ACCTGP
+8 SET ASUV("RPT")="R23"
SET ASUQ("HDR")="HEADER^ASURM23P"
+9 DO ^ASUUDATA
IF ASUX("NDTA")
GOTO K
+10 SET (ASUC("PG"),ASUMS("E#","ARE"))=0
+11 FOR
SET ASUMS("E#","ARE")=$ORDER(^XTMP("ASUR","R23",ASUMS("E#","ARE")))
IF ASUMS("E#","ARE")']""
QUIT
Begin DoDot:1
+12 DO ARE^ASULARST($EXTRACT(ASUMS("E#","ARE"),1,2))
+13 SET ASURX("ACC")=0
+14 FOR
SET ASURX("ACC")=$ORDER(^XTMP("ASUR","R23",ASUMS("E#","ARE"),ASURX("ACC")))
IF ASURX("ACC")']""
QUIT
Begin DoDot:2
+15 DO ACC^ASULDIRF(ASURX("ACC"))
DO ACCTGP
+16 SET ASUV("ACCGP")=$GET(ASUL(9,"ACC","GP"))
+17 SET ASUMS("E#","IDX")=0
+18 IF ASUC("LINE")>(IOSL-2)
DO HEADER
IF $DATA(DTOUT)
QUIT
IF $DATA(DUOUT)
QUIT
+19 FOR
SET ASUMS("E#","IDX")=$ORDER(^XTMP("ASUR","R23",ASUMS("E#","ARE"),ASURX("ACC"),ASUMS("E#","IDX")))
IF ASUMS("E#","IDX")']""
QUIT
Begin DoDot:3
+20 SET ASUMX("E#","IDX")=ASUMS("E#","IDX")
+21 DO READ^ASUMXDIO
+22 WRITE !?2,$EXTRACT(ASUMX("IDX"),1,5),".",$EXTRACT(ASUMX("IDX"),6),?15,ASUMX("DESC",1)," ",ASUMX("DESC",2),?85,ASUMX("AR U/I")
+23 SET ASUC("LINE")=ASUC("LINE")+2
+24 SET ASUMS("E#","STA")=0
+25 FOR
SET ASUMS("E#","STA")=$ORDER(^XTMP("ASUR","R23",ASUMS("E#","ARE"),ASURX("ACC"),ASUMS("E#","IDX"),ASUMS("E#","STA")))
IF ASUMS("E#","STA")']""
QUIT
Begin DoDot:4
+26 SET ASUX(0)=^XTMP("ASUR","R23",ASUMS("E#","ARE"),ASURX("ACC"),ASUMS("E#","IDX"),ASUMS("E#","STA"))
+27 SET ASUC(0,0,"QTY")=$PIECE(ASUX(0),U)
SET ASUV("AST")=$PIECE(ASUX(0),U,2)
+28 DO STA^ASULARST(ASUMS("E#","STA"))
DO ^ASUMSTRD
+29 SET ASUC(1,ASUMS("E#","STA"))=$EXTRACT(ASUL(2,"STA","NM"),1,22)
+30 WRITE !?4,$EXTRACT(ASUL(2,"STA","NM"),1,22),?26,ASUMS("SLC")
+31 DO NSNFMT
WRITE ?28,ASUV("NSN"),?48,ASUMS("VENAM"),?65,ASUMS("EOQ","TP")
+32 WRITE ?68,$JUSTIFY($FNUMBER(ASUC(0,0,"QTY"),","),7),ASUV("AST"),?80,$JUSTIFY($FNUMBER(ASUMS("CST/U"),",",2),8)
+33 SET ASUC(0,0,"VAL")=(ASUC(0,0,"QTY")*(+ASUMS("CST/U")))
+34 WRITE ?90,$JUSTIFY($FNUMBER(ASUC(0,0,"VAL"),",",2),10),?101,$GET(ASUL(2,"STA","CTP")),?116,$GET(ASUL(2,"STA","TP#"))
+35 SET ASUC("LINE")=ASUC("LINE")+1
+36 SET ASUC(0,0,"LI")=1
+37 SET ASUV("STA")=ASUMS("E#","STA")
DO ROLL(0)
End DoDot:4
IF $DATA(DUOUT)
QUIT
IF $DATA(DTOUT)
QUIT
+38 IF $DATA(DTOUT)
QUIT
IF $DATA(DUOUT)
QUIT
+39 DO STALOOP(0,"ITEM")
IF $DATA(DTOUT)
QUIT
IF $DATA(DUOUT)
QUIT
+40 IF ASUC("LINE")>(IOSL-2)
DO HEADER
End DoDot:3
IF $DATA(DUOUT)
QUIT
IF $DATA(DTOUT)
QUIT
+41 IF $DATA(DTOUT)
QUIT
IF $DATA(DUOUT)
QUIT
+42 WRITE !!
SET Y="ACCOUNT "_ASUV("ACCGP")
DO STALOOP(1,Y)
IF $DATA(DTOUT)
QUIT
IF $DATA(DUOUT)
QUIT
+43 DO HEADER
IF $DATA(DUOUT)
QUIT
IF $DATA(DTOUT)
QUIT
End DoDot:2
IF $DATA(DUOUT)
QUIT
IF $DATA(DTOUT)
QUIT
+44 IF $DATA(DTOUT)
QUIT
IF $DATA(DUOUT)
QUIT
+45 WRITE !!!
SET Y="AREA "_ASUL(1,"AR","NM")
DO STALOOP(2,Y)
IF $DATA(DTOUT)
QUIT
IF $DATA(DUOUT)
QUIT
+46 SET ASUC("LINE")=IOSL
End DoDot:1
IF $DATA(DUOUT)
QUIT
IF $DATA(DTOUT)
QUIT
K ;
+1 DO PAZ^ASUURHDR
IF ASUK("PTRSEL")']""
Begin DoDot:1
+2 DO C^ASUUZIS
End DoDot:1
+3 KILL ASUMX,ASUMS,ASURX,ASUX,ASUC
+4 QUIT
ACCTGP ;
+1 SET ASUL(9,"ACC","GP")=$SELECT(ASURX("ACC")=1:ASUL(9,"ACC","NM"),ASURX("ACC")=3:ASUL(9,"ACC","NM"),1:"GENERAL SUPPLIES")
+2 SET ASUV("PRTACC")=$SELECT(ASUL(9,"ACC","GP")="GENERAL SUPPLIES":"*",1:ASURX("ACC"))
+3 QUIT
NSNFMT ;
+1 IF ASUMS("ORD#")]""
Begin DoDot:1
+2 IF $EXTRACT(ASUMS("ORD#"))="M"
SET ASUV("NSN")=ASUMS("ORD#")
QUIT
+3 IF ASUMS("ORD#")]""
SET ASUV("NSN")=ASUMS("ORD#")
+4 IF '$TEST
SET ASUV("NSN")=ASUMX("NSN")
+5 IF $LENGTH(ASUV("NSN"))=4
QUIT
+6 SET ASUV("NSN")=$EXTRACT(ASUV("NSN"),1,4)_"-"_$EXTRACT(ASUV("NSN"),5,$LENGTH(ASUV("NSN")))
+7 IF $LENGTH(ASUV("NSN"))>7
SET ASUV("NSN")=$EXTRACT(ASUV("NSN"),1,7)_"-"_$EXTRACT(ASUV("NSN"),8,$LENGTH(ASUV("NSN")))
+8 IF $LENGTH(ASUV("NSN"))>11
SET ASUV("NSN")=$EXTRACT(ASUV("NSN"),1,11)_"-"_$EXTRACT(ASUV("NSN"),12,$LENGTH(ASUV("NSN")))
End DoDot:1
+9 QUIT
+1 NEW X,Y
+2 SET ASUC("PG")=$GET(ASUC("PG"))+1
SET ASUC("LINE")=6
+3 IF ASUC("PG")>1
DO PAZ^ASUURHDR
+4 IF $DATA(DTOUT)
QUIT
IF $DATA(DUOUT)
QUIT
+5 WRITE @(IOF),"REPORT #23 LISTING OF OVERSTOCKED SUPPLIES",?90,ASUK("DT"),?110,"PAGE",?115,$JUSTIFY($FNUMBER(ASUC("PG"),","),7)
+6 WRITE !,"AREA",?6,ASUL(1,"AR","AP"),?9,ASUL(1,"AR","NM")
+7 WRITE !,?50,"G L ACCOUNT 125.",ASUV("PRTACC"),?68,ASUL(9,"ACC","GP"),!
+8 WRITE !?4,"INDEX",?20,"DESCRIPTION",?84,"UI"
+9 WRITE !?6,"STATION",?25,"SLC",?29,"ORDER NUMBER",?50,"VENDOR NAME",?65,"TC",?70,"QTY",?83,"U/COST",?93,"T-VALUE",?101,"CONTACT PERSON TELEPHONE #",!
+10 QUIT
STALOOP(X,Y) ;
+1 SET ASUV("STA")=""
+2 FOR ASUC=1:1
SET ASUV("STA")=$ORDER(ASUC(X,ASUV("STA")))
IF ASUV("STA")']""
QUIT
Begin DoDot:1
+3 IF ASUC'>1
WRITE !?20,"STATIONS TOTALS FOR ",Y
SET ASUC("LINE")=$GET(ASUC("LINE"))+1
IF X>0
WRITE !
SET ASUC("LINE")=$GET(ASUC("LINE"))+2
+4 IF X>0
Begin DoDot:2
+5 DO ROLL(X)
+6 WRITE ?30,ASUC(X,ASUV("STA"))
+7 WRITE ?68,$JUSTIFY($FNUMBER(ASUC(X,ASUV("STA"),"QTY"),","),7),?90,$JUSTIFY($FNUMBER(ASUC(X,ASUV("STA"),"VAL"),",",2),10),?105,"LI - ",$JUSTIFY($FNUMBER($GET(ASUC(X,ASUV("STA"),"LI")),","),8),!
+8 SET ASUC("LINE")=$GET(ASUC("LINE"))+1
End DoDot:2
+9 SET ASUC("TQTY")=$GET(ASUC("TQTY"))+ASUC(X,ASUV("STA"),"QTY")
+10 SET ASUC("TVAL")=$GET(ASUC("TVAL"))+ASUC(X,ASUV("STA"),"VAL")
+11 SET ASUC("TLI")=$GET(ASUC("TLI"))+ASUC(X,ASUV("STA"),"LI")
+12 KILL ASUC(X,ASUV("STA"))
End DoDot:1
IF $DATA(DUOUT)
QUIT
IF $DATA(DTOUT)
QUIT
+13 WRITE ?68,"_______ __________"
+14 IF X>0
WRITE ?110,"________"
+15 WRITE !?68,$JUSTIFY($FNUMBER(ASUC("TQTY"),","),7),?90,$JUSTIFY($FNUMBER(ASUC("TVAL"),",",2),10)
+16 IF X>0
WRITE ?110,$JUSTIFY($FNUMBER($GET(ASUC("TLI")),","),8)
+17 WRITE !
+18 IF ASUC("LINE")>(IOSL-2)
DO HEADER
+19 IF $DATA(DTOUT)
QUIT
IF $DATA(DUOUT)
QUIT
+20 KILL ASUC("TQTY"),ASUC("TVAL")
+21 SET ASUC("LINE")=$GET(ASUC("LINE"))+2
+22 QUIT
ROLL(X) ;
+1 SET ASUV("STF")=$SELECT(X=0:0,1:ASUV("STA"))
+2 IF X>0
SET ASUC(X+1,ASUV("STA"))=ASUC(X,ASUV("STF"))
+3 SET ASUC(X+1,ASUV("STA"),"QTY")=$GET(ASUC(X+1,ASUV("STA"),"QTY"))+$GET(ASUC(X,ASUV("STF"),"QTY"))
+4 SET ASUC(X+1,ASUV("STA"),"VAL")=$GET(ASUC(X+1,ASUV("STA"),"VAL"))+$GET(ASUC(X,ASUV("STF"),"VAL"))
+5 SET ASUC(X+1,ASUV("STA"),"LI")=$GET(ASUC(X+1,ASUV("STA"),"LI"))+$GET(ASUC(X,ASUV("STF"),"LI"))
+6 QUIT
SORT ;EP ;
+1 KILL ^XTMP("ASUR","R23")
+2 SET ^XTMP("ASUR","R23",0)=ASUK("DT","FM")+10000_U_ASUK("DT","FM")
+3 SET ASUMS("E#","STA")=0
+4 FOR
SET ASUMS("E#","STA")=$ORDER(^ASUMS(ASUMS("E#","STA")))
IF ASUMS("E#","STA")'?1N.N
QUIT
Begin DoDot:1
+5 FOR ASUMS("E#","IDX")=0:0
SET ASUMS("E#","IDX")=$ORDER(^ASUMS(ASUMS("E#","STA"),1,ASUMS("E#","IDX")))
IF ASUMS("E#","IDX")'?1N.N
QUIT
Begin DoDot:2
+6 SET ASUMS("LSTISS")=$PIECE(^ASUMS(ASUMS("E#","STA"),1,ASUMS("E#","IDX"),0),U,13)
+7 SET ASUV("LIMOS")=$EXTRACT(ASUK("DT","FM"),1,5)-$EXTRACT(ASUMS("LSTISS"),1,5)
+8 DO ^ASUMSTRD
+9 IF ASUMS("QTY","O/H")'>0
QUIT
+10 SET ASUMX("ACC")=$PIECE($GET(^ASUMX(ASUMS("E#","IDX"),0)),U,6)
+11 IF ASUMX("ACC")']""
QUIT
+12 SET ASUMX("ACCTYP")=$SELECT(ASUMX("ACC")=1:1,ASUMX("ACC")=3:3,1:4)
+13 IF ASUV("LIMOS")>12
Begin DoDot:3
+14 SET ASUC(0,0,"QTY")=ASUMS("QTY","O/H")
SET ASUV("AST")="*"
End DoDot:3
+15 IF '$TEST
Begin DoDot:3
+16 IF "PN"[ASUMS("EOQ","TP")
SET ASUC(0,0,"QTY")=""
QUIT
+17 SET ASUV("QTYNEED")=(ASUMS("PMIQ")*12)+ASUMS("RPQ")
SET ASUC(0,0,"QTY")=ASUMS("QTY","O/H")-ASUV("QTYNEED")
+18 IF ASUC(0,0,"QTY")<1
SET ASUC(0,0,"QTY")=""
QUIT
+19 SET ASUV("AST")=""
End DoDot:3
IF ASUC(0,0,"QTY")']""
QUIT
+20 SET ASUMS("E#","ARE")=$EXTRACT(ASUMS("E#","STA"),1,2)
+21 SET ^XTMP("ASUR","R23",ASUMS("E#","ARE"),ASUMX("ACCTYP"),ASUMS("E#","IDX"),ASUMS("E#","STA"))=ASUC(0,0,"QTY")_U_ASUV("AST")
End DoDot:2
End DoDot:1
+22 QUIT
