ASURO80P ; IHS/ITSC/LMH -RPT 80 ISS-ANAL STATION DRIVER ;
;;4.2T2;Supply Accounting Mgmt. System;;JUN 30, 2000
;This routine formats and prints report 80, Analysis of Stock Issues
;by selected criteria Report.
EN ;EP;PRIMARY ENTRY POINT FOR REPORT 80
Q ;WAR 5/21/99
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
D ^ASURO800
Q:$D(DTOUT) Q:$D(DUOUT) ;DFM P1 9/15/98
S ZTRTN="PSER^ASURO80P",ZTDESC="SAMS RPT 80" D O^ASUUZIS
I POP S IOP=$I D ^%ZIS Q
I ASUK(ASUK("PTR"),"Q") Q
PSER ;EP;FOR TASKMAN QUEUE OF PRINT
G:$D(DTOUT) K G:$D(DUOUT) K
D U^ASUUZIS
S ASUF("HDR")=1
S ASUX("STA")=$O(^XTMP("ASUR","R80",2,"")) I ASUX("STA")']"" W !,"NO DATA FOR REPORT 80" Q
S Y=$P(^XTMP("ASUR","R80",2),U),ASUV("FY")=$S($E(Y,4,5)>9:$E(Y,1,3)+1,1:$E(Y,1,3))
X ^DD("DD") S ASUV("DT")=Y,ASUC("PG")=0
;S ASUX("STA")=""
;F S ASUX("STA")=$O(^XTMP("ASUR","R80",2,ASUX("STA"))) Q:ASUX("STA")="" D
S ASUX("STA")=$G(ASUL(2,"STA","E#")) I ASUX("STA")']"" D Q
.W !,"Station not selected at logon - can't determine Station to print"
E D
.S ASUA("AR")=$E(ASUX("STA"),1,2),ASUV("ARE")=ASUA("AR")
.I ASUA("AR")'=ASUL(1,"AR","AP") D ARE^ASULARST(ASUV("ARE"))
.S ASUA("STA")=$P(^XTMP("ASUR","R80",2,ASUX("STA")),U)
.;S ASUL(2,"E#","STA")=ASUX("STA") D STA^ASULARST(ASUL(2,"E#","STA"))
.S ASUX("ACC")=""
.F S ASUX("ACC")=$O(^XTMP("ASUR","R80",2,ASUX("STA"),ASUX("ACC"))) Q:ASUX("ACC")'?1N D P1
I $D(DUOUT)!($D(DTOUT)) G K
I ('$D(ASUV("ACC")))!('$D(ASUV("OBJ")))!('$D(ASUV("CAT"))) G K
S ASUV("LEV")=5 D PRTOTL
D CLS^ASUUHDG
K ;
K ASUC,ASUF,ASUT,ASUV,ASUP,ASUS,ASUX,ASUT
F X=3:1:22 K ASUL(X) ;Clear Table Lookup fields
K DFOUT,DIR,DLOUT,DTOUT,DUOUT
K X,X1,X2,X3,X4,Y
I ASUK("PTRSEL")]"" Q
D C^ASUUZIS
Q
P1 ;
S ASUA("ACC")=^XTMP("ASUR","R80",0,ASUX("ACC")),ASUV("ACC")=ASUX("ACC")
S ASUX("OBJ")=""
F S ASUX("OBJ")=$O(^XTMP("ASUR","R80",2,ASUX("STA"),ASUX("ACC"),ASUX("OBJ"))) Q:ASUX("OBJ")="" Q:$D(DTOUT) Q:$D(DUOUT) D
.S ASUA("OBJ")=^XTMP("ASUR","R80",0,ASUX("ACC"),ASUX("OBJ")),ASUV("OBJ")=ASUX("OBJ")
.S ASUX("CAT")=""
.F S ASUX("CAT")=$O(^XTMP("ASUR","R80",2,ASUX("STA"),ASUX("ACC"),ASUX("OBJ"),ASUX("CAT"))) Q:ASUX("CAT")="" Q:$D(DTOUT) Q:$D(DUOUT) D
..S ASUA("CAT")=^XTMP("ASUR","R80",0,ASUX("ACC"),ASUX("OBJ"),ASUX("CAT")),ASUV("CAT")=ASUX("CAT")
..D P4
.Q:$D(DTOUT) Q:$D(DUOUT)
.S ASUV("LEV")=3 D PRTOTL
Q:$D(DTOUT) Q:$D(DUOUT)
S ASUV("LEV")=4 D PRTOTL
Q
P2 ;
PRLINE ;PRINT LINE
W !?5,$P(ASUA(ASUV("LEV"),ASUV("SST")),U)
S ASUC("LN")=ASUC("LN")+1
D PRLIN2,PRLIN3,P3
Q
PRLI2 ;
S:ASUC("LN")>ASUK(ASUK("PTR"),"IOSL") ASUF("HDR")=1
PRLIN2 ;
F ASUV("PIECE")=2:1:4 D
.W ?30+((ASUV("PIECE")-2)*9),$J($FN($P(ASUA(ASUV("LEV"),ASUV("SST")),U,ASUV("PIECE")),"+T",0),9) D:ASUV("SST")>0
..S ASUV("%TOT")=$P(ASUA(ASUV("LEV"),0),U,ASUV("PIECE"))
..I ASUV("%TOT")<1 D
...S ASUV("%")="0.0"
..E D
...S ASUV("%SST")=$P(ASUA(ASUV("LEV"),ASUV("SST")),U,ASUV("PIECE"))*100
...S ASUV("%")=ASUV("%SST")/ASUV("%TOT")
..S $P(ASUA(ASUV("LEV"),ASUV("SST")),U,ASUV("PIECE")+3)=$FN(ASUV("%"),"-",1)_"%"
Q
PRLIN3 ;
F ASUV("PIECE")=5:1:7 W ?55+((ASUV("PIECE")-5)*7),$J($P(ASUA(ASUV("LEV"),ASUV("SST")),U,ASUV("PIECE")),7)
Q
PRTOTL ;EP; -PRINT TOTALS
D:ASUF("HDR") HEADER
W !,$P($T(TOTNAM+ASUV("LEV")),";",4)
S ASUC("LN")=ASUC("LN")+1
D:ASUV("LEV")<5 ROLLTOT
I ASUV("LEV")=1 D
.D PRDASH
.W !?7,$P($T(TOTNAM+ASUV("LEV")),";",3)
.S ASUU(2)=ASUV("SST"),ASUV("SST")=0
.D PRLI2 D:ASUF("HDR") HEADER
.F S ASUV("SST")=$O(ASUA(ASUV("LEV"),ASUV("SST"))) Q:ASUV("SST")'?1N.N D P3
.S ASUV("SST")=ASUU(2)
E D
.S ASUF("HDR")=1
.S ASUU(2)=ASUV("SST"),ASUV("SST")=0
.W ! S ASUC("LN")=ASUC("LN")+1
.F S ASUV("SST")=$O(ASUA(ASUV("LEV"),ASUV("SST"))) Q:ASUV("SST")'?1N.N D
..W !?5,$P(ASUA(ASUV("LEV"),ASUV("SST")),U)
..S ASUC("LN")=ASUC("LN")+1
..D PRLIN2,PRLIN3
..D P3
.W ! D PRDASH
.S ASUC("LN")=ASUC("LN")+1
.W !!?12,$P($T(TOTNAM+ASUV("LEV")),";",3)
.S ASUC("LN")=ASUC("LN")+1
.S ASUV("SST")=0
.D PRLI2
.S ASUV("SST")=ASUU(2)
S ASUC("LN")=ASUC("LN")+1
W !
S ASUC("LN")=ASUC("LN")+1
F ASUU(4)=0:1:2 S X=(ASUU(4)*9)+30 W ?X," ========"
S ASUC("LN")=ASUC("LN")+1
K ASUA(ASUV("LEV"))
Q
PRDASH ;
F ASUU(4)=0:1:2 S X=(ASUU(4)*9)+30 W ?X," ________"
W ! S ASUC("LN")=ASUC("LN")+1
Q
S ASUC("PG")=ASUC("PG")+1
D:ASUC("PG")>1 PAZ^ASUURHDR
W @IOF,!,"REPORT #80 ANALYSIS OF ISSUE VALUES BY ITEM/LOCATION/CATEGORY",?71,"PAGE :",$J(ASUC("PG"),3)
W !,"AREA: ",ASUL(1,"AR","AP")," -",ASUL(1,"AR","NM"),?35,"DATE : ",ASUV("DT")
W !,"STAT: ",ASUL(2,"STA","CD")," -",ASUL(2,"STA","NM")
W ?40,"GL ACCOUNT : ",ASUV("ACC")," ",$P(ASUA("ACC"),U,2)
W !,"OBJECT/SUBOBJECT CODE: ",$E(ASUV("OBJ"),1,2),".",$E(ASUV("OBJ"),3,4)," -",$P(ASUA("OBJ"),U,2),!
W !,"CATEGORY: ",ASUV("CAT")," -",$P(ASUA("CAT"),U,2),!
W !?3,"INDEX ITEM PERCENT OF TOTAL"
W !?2,"NUMBER DESCRIPTION STORES STOCK ISSUE VALUES ISSUE VALUE",?78,"U"
W !?6,"USING LOCATION",?32,"FY-",$E(ASUV("FY"),2,3),?42,"FY-",$E((ASUV("FY")-1),2,3),?52,"FY-",$E((ASUV("FY")-2),2,3)
W ?59,"FY-",$E(ASUV("FY"),2,3),?66,"FY-",$E((ASUV("FY")-1),2,3),?73,"FY-",$E((ASUV("FY")-2),2,3)
W ! F ASUU(3)=1:1:80 W "_"
W !!
S ASUC("LN")=13,ASUF("HDR")=0
Q
TOTNAM ;;
;;ITEM TOTAL
;;CATEGORY TOTAL;SUMMARY BY CATEGORY
;;OBJ/SUB OBJ TOTAL;SUMMARY BY OBJ/SUB OBJ
;;ACCOUNT TOTAL;SUMMARY BY ACCOUNT
;;AREA TOTAL;SUMMARY BY AREA
P3 ;
S $P(ASUA(ASUV("LEV")+1,ASUV("SST")),U)=$P(ASUA(ASUV("LEV"),ASUV("SST")),U)
F ASUU(1)=2:1:4 D
.S $P(ASUA(ASUV("LEV")+1,ASUV("SST")),U,ASUU(1))=$P(ASUA(ASUV("LEV")+1,ASUV("SST")),U,ASUU(1))+$P(ASUA(ASUV("LEV"),ASUV("SST")),U,ASUU(1))
K ASUA(ASUV("LEV"),ASUV("SST"))
Q
ROLLTOT ;EP ;ACCUMULATE TOTALS
S ASUA(ASUV("LEV")+1,0)=$G(ASUA(ASUV("LEV")+1,0))
F ASUU(1)=2:1:4 D
.S $P(ASUA(ASUV("LEV")+1,0),U,ASUU(1))=$P(ASUA(ASUV("LEV")+1,0),U,ASUU(1))+$P(ASUA(ASUV("LEV"),0),U,ASUU(1))
Q
ZEROTOT ;
K ASUA(ASUV("LEV"))
Q
P4 ;
S ASUX("DSC")=""
F S ASUX("DSC")=$O(^XTMP("ASUR","R80",2,ASUX("STA"),ASUX("ACC"),ASUX("OBJ"),ASUX("CAT"),ASUX("DSC"))) Q:ASUX("DSC")="" Q:$D(DTOUT) Q:$D(DUOUT) D
.S ASUX(0,"DSC")=^XTMP("ASUR","R80",2,ASUX("STA"),ASUX("ACC"),ASUX("OBJ"),ASUX("CAT"),ASUX("DSC"))
.S ASUA(0,0)=""
.F ASUU(1)=1:1:3 S ASUA(0,0)=ASUA(0,0)_U_$P(ASUX(0,"DSC"),U,ASUU(1))
.S ASUA("IDX")=$P(ASUX(0,"DSC"),U,5)
.S ASUA("DS2")=$P(ASUX(0,"DSC"),U,6)
.D:ASUF("HDR") HEADER
.W !!,$E(ASUA("IDX"),1,5),".",$E(ASUA("IDX"),6,6),?8,ASUX("DSC")," ",ASUA("DS2"),!
.S ASUC("LN")=ASUC("LN")+3
.D P5 ;SUBSTATION
Q:$D(DTOUT) Q:$D(DUOUT)
S ASUV("LEV")=2 D PRTOTL
Q
P5 ;
S ASUX("SST")=""
F S ASUX("SST")=$O(^XTMP("ASUR","R80",2,ASUX("STA"),ASUX("ACC"),ASUX("OBJ"),ASUX("CAT"),ASUX("DSC"),ASUX("SST"))) Q:ASUX("SST")="" Q:$D(DTOUT) Q:$D(DUOUT) D
.S ASUV("LEV")=0
.S ASUV("SST")=ASUX("SST")
.S ASUA(0,ASUV("SST"))=^XTMP("ASUR","R80",2,ASUX("STA"),ASUX("ACC"),ASUX("OBJ"),ASUX("CAT"),ASUX("DSC"),ASUX("SST"))
.D ACC^ASULDIRF(ASUX("ACC"))
.S:ASUC("LN")>ASUK(ASUK("PTR"),"IOSL") ASUF("HDR")=1
.D:ASUF("HDR") HEADER
.D PRLINE
D ROLLTOT
S ASUV("LEV")=1 D PRTOTL
Q
ASURO80P ; IHS/ITSC/LMH -RPT 80 ISS-ANAL STATION DRIVER ;
+1 ;;4.2T2;Supply Accounting Mgmt. System;;JUN 30, 2000
+2 ;This routine formats and prints report 80, Analysis of Stock Issues
+3 ;by selected criteria Report.
EN ;EP;PRIMARY ENTRY POINT FOR REPORT 80
+1 ;WAR 5/21/99
QUIT
+2 IF '$DATA(IO)
DO HOME^%ZIS
+3 IF '$DATA(DUZ(2))
WRITE !,"Report must be run from Kernel option"
QUIT
+4 IF '$DATA(ASUL(1,"AR","AP"))
DO SETAREA^ASULARST
+5 SET ASUK("PTRSEL")=$GET(ASUK("PTRSEL"))
IF ASUK("PTRSEL")]""
GOTO PSER
+6 DO ^ASURO800
+7 ;DFM P1 9/15/98
IF $DATA(DTOUT)
QUIT
IF $DATA(DUOUT)
QUIT
+8 SET ZTRTN="PSER^ASURO80P"
SET ZTDESC="SAMS RPT 80"
DO O^ASUUZIS
+9 IF POP
SET IOP=$IO
DO ^%ZIS
QUIT
+10 IF ASUK(ASUK("PTR"),"Q")
QUIT
PSER ;EP;FOR TASKMAN QUEUE OF PRINT
+1 IF $DATA(DTOUT)
GOTO K
IF $DATA(DUOUT)
GOTO K
+2 DO U^ASUUZIS
+3 SET ASUF("HDR")=1
+4 SET ASUX("STA")=$ORDER(^XTMP("ASUR","R80",2,""))
IF ASUX("STA")']""
WRITE !,"NO DATA FOR REPORT 80"
QUIT
+5 SET Y=$PIECE(^XTMP("ASUR","R80",2),U)
SET ASUV("FY")=$SELECT($EXTRACT(Y,4,5)>9:$EXTRACT(Y,1,3)+1,1:$EXTRACT(Y,1,3))
+6 XECUTE ^DD("DD")
SET ASUV("DT")=Y
SET ASUC("PG")=0
+7 ;S ASUX("STA")=""
+8 ;F S ASUX("STA")=$O(^XTMP("ASUR","R80",2,ASUX("STA"))) Q:ASUX("STA")="" D
+9 SET ASUX("STA")=$GET(ASUL(2,"STA","E#"))
IF ASUX("STA")']""
Begin DoDot:1
+10 WRITE !,"Station not selected at logon - can't determine Station to print"
End DoDot:1
QUIT
+11 IF '$TEST
Begin DoDot:1
+12 SET ASUA("AR")=$EXTRACT(ASUX("STA"),1,2)
SET ASUV("ARE")=ASUA("AR")
+13 IF ASUA("AR")'=ASUL(1,"AR","AP")
DO ARE^ASULARST(ASUV("ARE"))
+14 SET ASUA("STA")=$PIECE(^XTMP("ASUR","R80",2,ASUX("STA")),U)
+15 ;S ASUL(2,"E#","STA")=ASUX("STA") D STA^ASULARST(ASUL(2,"E#","STA"))
+16 SET ASUX("ACC")=""
+17 FOR
SET ASUX("ACC")=$ORDER(^XTMP("ASUR","R80",2,ASUX("STA"),ASUX("ACC")))
IF ASUX("ACC")'?1N
QUIT
DO P1
End DoDot:1
+18 IF $DATA(DUOUT)!($DATA(DTOUT))
GOTO K
+19 IF ('$DATA(ASUV("ACC")))!('$DATA(ASUV("OBJ")))!('$DATA(ASUV("CAT")))
GOTO K
+20 SET ASUV("LEV")=5
DO PRTOTL
+21 DO CLS^ASUUHDG
K ;
+1 KILL ASUC,ASUF,ASUT,ASUV,ASUP,ASUS,ASUX,ASUT
+2 ;Clear Table Lookup fields
FOR X=3:1:22
KILL ASUL(X)
+3 KILL DFOUT,DIR,DLOUT,DTOUT,DUOUT
+4 KILL X,X1,X2,X3,X4,Y
+5 IF ASUK("PTRSEL")]""
QUIT
+6 DO C^ASUUZIS
+7 QUIT
P1 ;
+1 SET ASUA("ACC")=^XTMP("ASUR","R80",0,ASUX("ACC"))
SET ASUV("ACC")=ASUX("ACC")
+2 SET ASUX("OBJ")=""
+3 FOR
SET ASUX("OBJ")=$ORDER(^XTMP("ASUR","R80",2,ASUX("STA"),ASUX("ACC"),ASUX("OBJ")))
IF ASUX("OBJ")=""
QUIT
IF $DATA(DTOUT)
QUIT
IF $DATA(DUOUT)
QUIT
Begin DoDot:1
+4 SET ASUA("OBJ")=^XTMP("ASUR","R80",0,ASUX("ACC"),ASUX("OBJ"))
SET ASUV("OBJ")=ASUX("OBJ")
+5 SET ASUX("CAT")=""
+6 FOR
SET ASUX("CAT")=$ORDER(^XTMP("ASUR","R80",2,ASUX("STA"),ASUX("ACC"),ASUX("OBJ"),ASUX("CAT")))
IF ASUX("CAT")=""
QUIT
IF $DATA(DTOUT)
QUIT
IF $DATA(DUOUT)
QUIT
Begin DoDot:2
+7 SET ASUA("CAT")=^XTMP("ASUR","R80",0,ASUX("ACC"),ASUX("OBJ"),ASUX("CAT"))
SET ASUV("CAT")=ASUX("CAT")
+8 DO P4
End DoDot:2
+9 IF $DATA(DTOUT)
QUIT
IF $DATA(DUOUT)
QUIT
+10 SET ASUV("LEV")=3
DO PRTOTL
End DoDot:1
+11 IF $DATA(DTOUT)
QUIT
IF $DATA(DUOUT)
QUIT
+12 SET ASUV("LEV")=4
DO PRTOTL
+13 QUIT
P2 ;
PRLINE ;PRINT LINE
+1 WRITE !?5,$PIECE(ASUA(ASUV("LEV"),ASUV("SST")),U)
+2 SET ASUC("LN")=ASUC("LN")+1
+3 DO PRLIN2
DO PRLIN3
DO P3
+4 QUIT
PRLI2 ;
+1 IF ASUC("LN")>ASUK(ASUK("PTR"),"IOSL")
SET ASUF("HDR")=1
PRLIN2 ;
+1 FOR ASUV("PIECE")=2:1:4
Begin DoDot:1
+2 WRITE ?30+((ASUV("PIECE")-2)*9),$JUSTIFY($FNUMBER($PIECE(ASUA(ASUV("LEV"),ASUV("SST")),U,ASUV("PIECE")),"+T",0),9)
IF ASUV("SST")>0
Begin DoDot:2
+3 SET ASUV("%TOT")=$PIECE(ASUA(ASUV("LEV"),0),U,ASUV("PIECE"))
+4 IF ASUV("%TOT")<1
Begin DoDot:3
+5 SET ASUV("%")="0.0"
End DoDot:3
+6 IF '$TEST
Begin DoDot:3
+7 SET ASUV("%SST")=$PIECE(ASUA(ASUV("LEV"),ASUV("SST")),U,ASUV("PIECE"))*100
+8 SET ASUV("%")=ASUV("%SST")/ASUV("%TOT")
End DoDot:3
+9 SET $PIECE(ASUA(ASUV("LEV"),ASUV("SST")),U,ASUV("PIECE")+3)=$FNUMBER(ASUV("%"),"-",1)_"%"
End DoDot:2
End DoDot:1
+10 QUIT
PRLIN3 ;
+1 FOR ASUV("PIECE")=5:1:7
WRITE ?55+((ASUV("PIECE")-5)*7),$JUSTIFY($PIECE(ASUA(ASUV("LEV"),ASUV("SST")),U,ASUV("PIECE")),7)
+2 QUIT
PRTOTL ;EP; -PRINT TOTALS
+1 IF ASUF("HDR")
DO HEADER
+2 WRITE !,$PIECE($TEXT(TOTNAM+ASUV("LEV")),";",4)
+3 SET ASUC("LN")=ASUC("LN")+1
+4 IF ASUV("LEV")<5
DO ROLLTOT
+5 IF ASUV("LEV")=1
Begin DoDot:1
+6 DO PRDASH
+7 WRITE !?7,$PIECE($TEXT(TOTNAM+ASUV("LEV")),";",3)
+8 SET ASUU(2)=ASUV("SST")
SET ASUV("SST")=0
+9 DO PRLI2
IF ASUF("HDR")
DO HEADER
+10 FOR
SET ASUV("SST")=$ORDER(ASUA(ASUV("LEV"),ASUV("SST")))
IF ASUV("SST")'?1N.N
QUIT
DO P3
+11 SET ASUV("SST")=ASUU(2)
End DoDot:1
+12 IF '$TEST
Begin DoDot:1
+13 SET ASUF("HDR")=1
+14 SET ASUU(2)=ASUV("SST")
SET ASUV("SST")=0
+15 WRITE !
SET ASUC("LN")=ASUC("LN")+1
+16 FOR
SET ASUV("SST")=$ORDER(ASUA(ASUV("LEV"),ASUV("SST")))
IF ASUV("SST")'?1N.N
QUIT
Begin DoDot:2
+17 WRITE !?5,$PIECE(ASUA(ASUV("LEV"),ASUV("SST")),U)
+18 SET ASUC("LN")=ASUC("LN")+1
+19 DO PRLIN2
DO PRLIN3
+20 DO P3
End DoDot:2
+21 WRITE !
DO PRDASH
+22 SET ASUC("LN")=ASUC("LN")+1
+23 WRITE !!?12,$PIECE($TEXT(TOTNAM+ASUV("LEV")),";",3)
+24 SET ASUC("LN")=ASUC("LN")+1
+25 SET ASUV("SST")=0
+26 DO PRLI2
+27 SET ASUV("SST")=ASUU(2)
End DoDot:1
+28 SET ASUC("LN")=ASUC("LN")+1
+29 WRITE !
+30 SET ASUC("LN")=ASUC("LN")+1
+31 FOR ASUU(4)=0:1:2
SET X=(ASUU(4)*9)+30
WRITE ?X," ========"
+32 SET ASUC("LN")=ASUC("LN")+1
+33 KILL ASUA(ASUV("LEV"))
+34 QUIT
PRDASH ;
+1 FOR ASUU(4)=0:1:2
SET X=(ASUU(4)*9)+30
WRITE ?X," ________"
+2 WRITE !
SET ASUC("LN")=ASUC("LN")+1
+3 QUIT
+1 SET ASUC("PG")=ASUC("PG")+1
+2 IF ASUC("PG")>1
DO PAZ^ASUURHDR
+3 WRITE @IOF,!,"REPORT #80 ANALYSIS OF ISSUE VALUES BY ITEM/LOCATION/CATEGORY",?71,"PAGE :",$JUSTIFY(ASUC("PG"),3)
+4 WRITE !,"AREA: ",ASUL(1,"AR","AP")," -",ASUL(1,"AR","NM"),?35,"DATE : ",ASUV("DT")
+5 WRITE !,"STAT: ",ASUL(2,"STA","CD")," -",ASUL(2,"STA","NM")
+6 WRITE ?40,"GL ACCOUNT : ",ASUV("ACC")," ",$PIECE(ASUA("ACC"),U,2)
+7 WRITE !,"OBJECT/SUBOBJECT CODE: ",$EXTRACT(ASUV("OBJ"),1,2),".",$EXTRACT(ASUV("OBJ"),3,4)," -",$PIECE(ASUA("OBJ"),U,2),!
+8 WRITE !,"CATEGORY: ",ASUV("CAT")," -",$PIECE(ASUA("CAT"),U,2),!
+9 WRITE !?3,"INDEX ITEM PERCENT OF TOTAL"
+10 WRITE !?2,"NUMBER DESCRIPTION STORES STOCK ISSUE VALUES ISSUE VALUE",?78,"U"
+11 WRITE !?6,"USING LOCATION",?32,"FY-",$EXTRACT(ASUV("FY"),2,3),?42,"FY-",$EXTRACT((ASUV("FY")-1),2,3),?52,"FY-",$EXTRACT((ASUV("FY")-2),2,3)
+12 WRITE ?59,"FY-",$EXTRACT(ASUV("FY"),2,3),?66,"FY-",$EXTRACT((ASUV("FY")-1),2,3),?73,"FY-",$EXTRACT((ASUV("FY")-2),2,3)
+13 WRITE !
FOR ASUU(3)=1:1:80
WRITE "_"
+14 WRITE !!
+15 SET ASUC("LN")=13
SET ASUF("HDR")=0
+16 QUIT
TOTNAM ;;
+1 ;;ITEM TOTAL
+2 ;;CATEGORY TOTAL;SUMMARY BY CATEGORY
+3 ;;OBJ/SUB OBJ TOTAL;SUMMARY BY OBJ/SUB OBJ
+4 ;;ACCOUNT TOTAL;SUMMARY BY ACCOUNT
+5 ;;AREA TOTAL;SUMMARY BY AREA
P3 ;
+1 SET $PIECE(ASUA(ASUV("LEV")+1,ASUV("SST")),U)=$PIECE(ASUA(ASUV("LEV"),ASUV("SST")),U)
+2 FOR ASUU(1)=2:1:4
Begin DoDot:1
+3 SET $PIECE(ASUA(ASUV("LEV")+1,ASUV("SST")),U,ASUU(1))=$PIECE(ASUA(ASUV("LEV")+1,ASUV("SST")),U,ASUU(1))+$PIECE(ASUA(ASUV("LEV"),ASUV("SST")),U,ASUU(1))
End DoDot:1
+4 KILL ASUA(ASUV("LEV"),ASUV("SST"))
+5 QUIT
ROLLTOT ;EP ;ACCUMULATE TOTALS
+1 SET ASUA(ASUV("LEV")+1,0)=$GET(ASUA(ASUV("LEV")+1,0))
+2 FOR ASUU(1)=2:1:4
Begin DoDot:1
+3 SET $PIECE(ASUA(ASUV("LEV")+1,0),U,ASUU(1))=$PIECE(ASUA(ASUV("LEV")+1,0),U,ASUU(1))+$PIECE(ASUA(ASUV("LEV"),0),U,ASUU(1))
End DoDot:1
+4 QUIT
ZEROTOT ;
+1 KILL ASUA(ASUV("LEV"))
+2 QUIT
P4 ;
+1 SET ASUX("DSC")=""
+2 FOR
SET ASUX("DSC")=$ORDER(^XTMP("ASUR","R80",2,ASUX("STA"),ASUX("ACC"),ASUX("OBJ"),ASUX("CAT"),ASUX("DSC")))
IF ASUX("DSC")=""
QUIT
IF $DATA(DTOUT)
QUIT
IF $DATA(DUOUT)
QUIT
Begin DoDot:1
+3 SET ASUX(0,"DSC")=^XTMP("ASUR","R80",2,ASUX("STA"),ASUX("ACC"),ASUX("OBJ"),ASUX("CAT"),ASUX("DSC"))
+4 SET ASUA(0,0)=""
+5 FOR ASUU(1)=1:1:3
SET ASUA(0,0)=ASUA(0,0)_U_$PIECE(ASUX(0,"DSC"),U,ASUU(1))
+6 SET ASUA("IDX")=$PIECE(ASUX(0,"DSC"),U,5)
+7 SET ASUA("DS2")=$PIECE(ASUX(0,"DSC"),U,6)
+8 IF ASUF("HDR")
DO HEADER
+9 WRITE !!,$EXTRACT(ASUA("IDX"),1,5),".",$EXTRACT(ASUA("IDX"),6,6),?8,ASUX("DSC")," ",ASUA("DS2"),!
+10 SET ASUC("LN")=ASUC("LN")+3
+11 ;SUBSTATION
DO P5
End DoDot:1
+12 IF $DATA(DTOUT)
QUIT
IF $DATA(DUOUT)
QUIT
+13 SET ASUV("LEV")=2
DO PRTOTL
+14 QUIT
P5 ;
+1 SET ASUX("SST")=""
+2 FOR
SET ASUX("SST")=$ORDER(^XTMP("ASUR","R80",2,ASUX("STA"),ASUX("ACC"),ASUX("OBJ"),ASUX("CAT"),ASUX("DSC"),ASUX("SST")))
IF ASUX("SST")=""
QUIT
IF $DATA(DTOUT)
QUIT
IF $DATA(DUOUT)
QUIT
Begin DoDot:1
+3 SET ASUV("LEV")=0
+4 SET ASUV("SST")=ASUX("SST")
+5 SET ASUA(0,ASUV("SST"))=^XTMP("ASUR","R80",2,ASUX("STA"),ASUX("ACC"),ASUX("OBJ"),ASUX("CAT"),ASUX("DSC"),ASUX("SST"))
+6 DO ACC^ASULDIRF(ASUX("ACC"))
+7 IF ASUC("LN")>ASUK(ASUK("PTR"),"IOSL")
SET ASUF("HDR")=1
+8 IF ASUF("HDR")
DO HEADER
+9 DO PRLINE
End DoDot:1
+10 DO ROLLTOT
+11 SET ASUV("LEV")=1
DO PRTOTL
+12 QUIT
