ASURQ82P ; IHS/ITSC/LMH -RPT 82 LIST YEARLY ITEMS ;
;;4.2T2;Supply Accounting Mgmt. System;;JUN 30, 2000
;This routine formats and prints report 82, List of Yearly
;Items.
EN ;EP;PRIMARY ENTRY POINT FOR REPORT 82
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
S ZTRTN="PSER^ASURQ82P",ZTDESC="SAMS RPT 82" D O^ASUUZIS
I POP S IOP=$I D ^%ZIS Q
I ASUK(ASUK("PTR"),"Q") Q
PSER ;EP;FOR TASKMAN QUEUE OF PRINT
S ASUF("HDR")=1
S ASUX("ARST")=$O(^XTMP("ASUR","R82",0))
I ASUX("ARST")']"" D
.I $G(ASUP("TYP"))=0 Q
.D ^ASURQ810
D U^ASUUZIS
S ASUX("ARST")=$O(^XTMP("ASUR","R82",0))
I ASUX("ARST")']"" W !!,"No Data for Yearly Item Report for this quarter" G K
S (ASUX("STA"),ASUQA("STA"))=ASUX("ARST")
D ARE^ASULARST($P(^ASUL(1,$E(ASUX("ARST"),1,2),0),U,2))
S ASUQA("AR")=ASUL(1,"AR","AP")_" - "_ASUL(1,"AR","NM")
D STA^ASULARST($P(^XTMP("ASUR","R81",ASUX("ARST")),U))
S ASUQA("STA")=ASUL(2,"STA","CD")_" - "_ASUL(2,"STA","NM")
S Y=$P(^XTMP("ASUR","R82",0),U) X ^DD("DD") S ASUV("DT")=Y
S (ASUC("LN"),ASUC("PG"))=0
S ASUP("YR")=$E($P(^XTMP("ASUR","R81",0),U,2),1,4),ASUT("QTR")=$E($P(^XTMP("ASUR","R81",0),U,2),5,6)
S ASUQA("DIV")=$S(ASUT("QTR")="04":12,ASUT("QTR")="03":9,ASUT("QTR")="02":6,1:3)
S ASUX("ACIX")="" K ASUL(9)
F ASUC=0:1 S ASUX("ACIX")=$O(^XTMP("ASUR","R82",ASUX("ARST"),ASUX("ACIX"))) Q:ASUX("ACIX")="" D
.Q:$D(DTOUT) Q:$D(DUOUT)
.S ASUMX("ACC")=$E(ASUX("ACIX"))
.I $G(ASUL(9,"ACC"))'=ASUMX("ACC") D
..I $G(ASUL(9,"ACC"))]"" S ASUV("LEV")=1 D PRTOTL
..D ACC^ASULDIRF(ASUMX("ACC"))
..S ASUQA("ACC")=ASUL(9,"ACC")_" - "_ASUL(9,"ACC","NM")
.D P1
I $D(DUOUT)!($D(DTOUT))!(ASUC=0) G K
I ASUV("LEV")'=1 D
.S ASUV("LEV")=1 D PRTOTL
S ASUV("LEV")=2 D PRTOTL
D CLS^ASUUHDG
K ;
K ASUC,ASUQX,ASUR,ASUT,ASUV,ASUX,ASURZ,ASURZX,ASUMS
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 ASUMX("E#","IDX")=$E(ASUX("ACIX"),2,9) D READ^ASUMXDIO
;S ASUX(0)=^XTMP("ASUR","R82",ASUX("ARST"),ASUX("ACIX"))
S ASUX("REQ")="",ASUF("IDX")=0
F S ASUX("REQ")=$O(^XTMP("ASUR","R82",ASUX("ARST"),ASUX("ACIX"),ASUX("REQ"))) Q:ASUX("REQ")="" Q:$D(DTOUT) Q:$D(DUOUT) D
.F X=18,19,20,22 K ASUL(X)
.S ASUX("SST")=$E(ASUX("REQ"),1,5),ASUX("USR")=$E(ASUX("REQ"),1,2)_$E(ASUX("REQ"),6,9)
.F X=18,19 K ASUL(X)
.D SST^ASULDIRR(ASUX("SST")),USR^ASULDIRR(ASUX("USR"))
.S ASUQA("SST")=ASUL(18,"SST")_" - "_ASUL(18,"SST","NM")
.S ASUV("LEV")=0,ASUV("SST")=ASUX("SST")
.F X=20,22 K ASUL(X)
.D REQ^ASULDIRR(ASUX("REQ"))
.S ASUQA("USR")=ASUL(19,"USR")_" - "_ASUL(19,"USR","NM")
.S ASUQ=^XTMP("ASUR","R82",ASUX("ARST"),ASUX("ACIX"),ASUX("REQ"))
.S $P(ASUQA(0,ASUX("SST")),U)=$P(ASUQ,U)
.S $P(ASUQA(0,ASUX("SST")),U,2)=$P(ASUQ,U,2)
.S $P(ASUQA(0,ASUX("SST")),U,3)=$FN(($P(ASUQ,U,2)/ASUQA("DIV")),"",2)
.S $P(ASUQA(0,ASUX("SST")),U,4)=$P(ASUQ,U,3)
.S $P(ASUQA(0,ASUX("SST")),U,5)=$P(ASUQ,U,4)
.S $P(ASUQA(0,ASUX("SST")),U,6)=$FN(($P(ASUQ,U,3)/ASUQA("DIV")),"",2)
.D P3
.D:ASUF("HDR") HEADER Q:$D(DUOUT)
.W ! S ASUC("LN")=ASUC("LN")+1
.I ASUF("IDX")=1 D
..W ?10,ASUMX("DESC",2) S ASUF("IDX")=2
.E I ASUF("IDX")=0 D
..W ! S ASUC("LN")=ASUC("LN")+1
..W ?1,$E(ASUMX("IDX"),1,5)_"."_$E(ASUMX("IDX"),6,6)
..W ?10,ASUMX("DESC",1)
..W ?45,ASUMX("AR U/I")
.S ASUF("IDX")=1
.D P2
Q:$D(DTOUT) Q:$D(DUOUT)
I ASUF("IDX")=1 W !?10,ASUMX("DESC",2) S ASUC("LN")=ASUC("LN")+1
I ASUF("IDX") S ASUV("SST")=0 D PRTOTL
Q
P2 ;
W ?50,ASUL(18,"SST"),?55,ASUL(19,"USR")
PRLQTY ;
F ASUV("PIECE")=1:1:3 D
.S ASURZX=((ASUV("PIECE")-1)*10)+60
.S ASURZ=$J($FN($P(ASUQA(ASUV("LEV"),ASUX("SST")),U,ASUV("PIECE")),"+,T",0),10)
.D PRCOLM
PRLVAL ;EP ; PRINT VALUES ISSUED -CUR QTR/YTD/AVERAGE
F ASUV("PIECE")=4:1:6 D
.S ASURZX=((ASUV("PIECE")-4)*12)+90
.S ASURZ=$J($FN($P(ASUQA(ASUV("LEV"),ASUX("SST")),U,ASUV("PIECE")),"+,T",2),12)
.D PRCOLM
I ASUC("LN")>(IOSL-2) S ASUF("HDR")=1
Q
PRCOLM ;
W ?ASURZX,ASURZ
Q
PRTOTL ;PRINT TOTAL LINES
I ASUC("LN")>(IOSL-ASUV("LEV")*2) S ASUF("HDR")=1
D:ASUF("HDR") HEADER Q:$D(DUOUT)
W !,$P($T(TOTNAM+ASUV("LEV")),";",4)
S ASUC("LN")=ASUC("LN")+1
S ASUV("SST")=ASUL(18,"SST","E#"),ASUL(18,"SST","E#")=0
I ASUV("LEV")=0 D
.D PRDASH
.W !?35,$P($T(TOTNAM+ASUV("LEV")),";",3)
.S ASUC("LN")=ASUC("LN")+1
.D PRLQTY,PRDDSH
E D
.S ASUF("HDR")=1
.D PRSST
.S ASUL(18,"SST","E#")=0
.W !?55,$P($T(TOTNAM+ASUV("LEV")),";",3)
.S ASUC("LN")=ASUC("LN")+1
.D PRLVAL
.W ! D PRDDSHV
S ASUL(18,"SST","E#")=ASUV("SST")
K ASUQA(ASUV("LEV"))
Q
PRDASH ;
F ASUC=0:1:2 S X=(ASUC*10)+60 W ?X," _________"
PRDASHV ;
F ASUC=0:1:2 S X=(ASUC*12)+90 W ?X," ___________",?1,""
S ASUC("LN")=ASUC("LN")+1
Q
PRDDSH ;
W !
F ASUC=0:1:2 S X=(ASUC*10)+60 W ?X," ========="
PRDDSHV ;
F ASUC=0:1:2 S X=(ASUC*12)+90 W ?X," ===========",?1,""
S ASUC("LN")=ASUC("LN")+1
Q
S ASUV("SST")=0
F S ASUV("SST")=$O(ASUQA(ASUV("LEV"),ASUV("SST"))) Q:ASUV("SST")="" D
.W !?50,$E(ASUV("SST"),4,5)
.W ?55,$P($T(TOTNAM+ASUV("LEV")),";",3)
.D PRLVAL
W ! D PRDASHV
Q
S ASUC("PG")=ASUC("PG")+1
D:ASUC("PG")>1 PAZ^ASUURHDR Q:$D(DUOUT)
W @IOF,!,"REPORT #82 QUARTERLY LISTING OF YEARLY ITEMS",?70,"DATE : ",ASUV("DT"),?95,"PAGE :",$J(ASUC("PG"),3)
W !,"AREA: ",ASUQA("AR"),?50,$S(ASUT("QTR")="04":"LAST",ASUT("QTR")="03":"THIRD",ASUT("QTR")="02":"SECOND",1:"1ST")," QUARTER OF FISCAL YEAR ",ASUP("YR")
W !,"STAT: ",ASUQA("STA"),?53,"GL ACCOUNT : ",ASUQA("ACC")
W !!?68,"QUANTITY ISSUED",?96,"ISSUE VALUE ISSUE VALUE"
W !?3,"INDEX ITEM",?45,"U",?49,"SUB",?55,"USER",?64,"CURRENT",?83,"MONTHLY",?96,"CURRENT",?119,"MONTHLY"
W !?2,"NUMBER DESCRIPTION",?46,"I",?49,"STA",?55,"CODE",?64,"QUARTER",?76,"Y-T-D",?83,"AVERAGE",?96,"QUARTER",?110,"Y-T-D",?119,"AVERAGE"
W ! F ASUC=1:1:132 W "_"
W !!
S ASUC("LN")=10,ASUF("HDR")=0
Q
TOTNAM ;;ITEM TOTAL
;;GL ACCOUNT TOTAL VALUE;SUMMARY OF YEARLY ITEMS BY ACCOUNT
;;TOTAL VALUE YEARLY ITEMS;SUMMARY OF TOTAL VALUE YEARLY ITEMS
P3 ;
F ASUV("PIECE")=1:1:6 D
.S ASUQA(0,0)=$G(ASUQA(0,0))
.S $P(ASUQA(0,0),U,ASUV("PIECE"))=$P(ASUQA(0,0),U,ASUV("PIECE"))+$P(ASUQA(0,ASUX("SST")),U,ASUV("PIECE"))
F ASUV("LEVA")=0:1:2 D
.F ASUV("PIECE")=1:1:6 D
..S ASUQA(ASUV("LEVA")+1,ASUX("SST"))=$G(ASUQA(ASUV("LEVA")+1,ASUX("SST")))
..S $P(ASUQA(ASUV("LEVA")+1,ASUX("SST")),U,ASUV("PIECE"))=$P(ASUQA(ASUV("LEVA")+1,ASUX("SST")),U,ASUV("PIECE"))+$P(ASUQA(ASUV("LEVA"),ASUX("SST")),U,ASUV("PIECE"))
..S ASUQA(ASUV("LEVA")+1,0)=$G(ASUQA(ASUV("LEVA")+1,0))
..S $P(ASUQA(ASUV("LEVA")+1,0),U,ASUV("PIECE"))=$P(ASUQA(ASUV("LEVA")+1,0),U,ASUV("PIECE"))+$P(ASUQA(ASUV("LEVA"),ASUX("SST")),U,ASUV("PIECE"))
Q
ASURQ82P ; IHS/ITSC/LMH -RPT 82 LIST YEARLY ITEMS ;
+1 ;;4.2T2;Supply Accounting Mgmt. System;;JUN 30, 2000
+2 ;This routine formats and prints report 82, List of Yearly
+3 ;Items.
EN ;EP;PRIMARY ENTRY POINT FOR REPORT 82
+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 SET ZTRTN="PSER^ASURQ82P"
SET ZTDESC="SAMS RPT 82"
DO O^ASUUZIS
+7 IF POP
SET IOP=$IO
DO ^%ZIS
QUIT
+8 IF ASUK(ASUK("PTR"),"Q")
QUIT
PSER ;EP;FOR TASKMAN QUEUE OF PRINT
+1 SET ASUF("HDR")=1
+2 SET ASUX("ARST")=$ORDER(^XTMP("ASUR","R82",0))
+3 IF ASUX("ARST")']""
Begin DoDot:1
+4 IF $GET(ASUP("TYP"))=0
QUIT
+5 DO ^ASURQ810
End DoDot:1
+6 DO U^ASUUZIS
+7 SET ASUX("ARST")=$ORDER(^XTMP("ASUR","R82",0))
+8 IF ASUX("ARST")']""
WRITE !!,"No Data for Yearly Item Report for this quarter"
GOTO K
+9 SET (ASUX("STA"),ASUQA("STA"))=ASUX("ARST")
+10 DO ARE^ASULARST($PIECE(^ASUL(1,$EXTRACT(ASUX("ARST"),1,2),0),U,2))
+11 SET ASUQA("AR")=ASUL(1,"AR","AP")_" - "_ASUL(1,"AR","NM")
+12 DO STA^ASULARST($PIECE(^XTMP("ASUR","R81",ASUX("ARST")),U))
+13 SET ASUQA("STA")=ASUL(2,"STA","CD")_" - "_ASUL(2,"STA","NM")
+14 SET Y=$PIECE(^XTMP("ASUR","R82",0),U)
XECUTE ^DD("DD")
SET ASUV("DT")=Y
+15 SET (ASUC("LN"),ASUC("PG"))=0
+16 SET ASUP("YR")=$EXTRACT($PIECE(^XTMP("ASUR","R81",0),U,2),1,4)
SET ASUT("QTR")=$EXTRACT($PIECE(^XTMP("ASUR","R81",0),U,2),5,6)
+17 SET ASUQA("DIV")=$SELECT(ASUT("QTR")="04":12,ASUT("QTR")="03":9,ASUT("QTR")="02":6,1:3)
+18 SET ASUX("ACIX")=""
KILL ASUL(9)
+19 FOR ASUC=0:1
SET ASUX("ACIX")=$ORDER(^XTMP("ASUR","R82",ASUX("ARST"),ASUX("ACIX")))
IF ASUX("ACIX")=""
QUIT
Begin DoDot:1
+20 IF $DATA(DTOUT)
QUIT
IF $DATA(DUOUT)
QUIT
+21 SET ASUMX("ACC")=$EXTRACT(ASUX("ACIX"))
+22 IF $GET(ASUL(9,"ACC"))'=ASUMX("ACC")
Begin DoDot:2
+23 IF $GET(ASUL(9,"ACC"))]""
SET ASUV("LEV")=1
DO PRTOTL
+24 DO ACC^ASULDIRF(ASUMX("ACC"))
+25 SET ASUQA("ACC")=ASUL(9,"ACC")_" - "_ASUL(9,"ACC","NM")
End DoDot:2
+26 DO P1
End DoDot:1
+27 IF $DATA(DUOUT)!($DATA(DTOUT))!(ASUC=0)
GOTO K
+28 IF ASUV("LEV")'=1
Begin DoDot:1
+29 SET ASUV("LEV")=1
DO PRTOTL
End DoDot:1
+30 SET ASUV("LEV")=2
DO PRTOTL
+31 DO CLS^ASUUHDG
K ;
+1 KILL ASUC,ASUQX,ASUR,ASUT,ASUV,ASUX,ASURZ,ASURZX,ASUMS
+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 ASUMX("E#","IDX")=$EXTRACT(ASUX("ACIX"),2,9)
DO READ^ASUMXDIO
+2 ;S ASUX(0)=^XTMP("ASUR","R82",ASUX("ARST"),ASUX("ACIX"))
+3 SET ASUX("REQ")=""
SET ASUF("IDX")=0
+4 FOR
SET ASUX("REQ")=$ORDER(^XTMP("ASUR","R82",ASUX("ARST"),ASUX("ACIX"),ASUX("REQ")))
IF ASUX("REQ")=""
QUIT
IF $DATA(DTOUT)
QUIT
IF $DATA(DUOUT)
QUIT
Begin DoDot:1
+5 FOR X=18,19,20,22
KILL ASUL(X)
+6 SET ASUX("SST")=$EXTRACT(ASUX("REQ"),1,5)
SET ASUX("USR")=$EXTRACT(ASUX("REQ"),1,2)_$EXTRACT(ASUX("REQ"),6,9)
+7 FOR X=18,19
KILL ASUL(X)
+8 DO SST^ASULDIRR(ASUX("SST"))
DO USR^ASULDIRR(ASUX("USR"))
+9 SET ASUQA("SST")=ASUL(18,"SST")_" - "_ASUL(18,"SST","NM")
+10 SET ASUV("LEV")=0
SET ASUV("SST")=ASUX("SST")
+11 FOR X=20,22
KILL ASUL(X)
+12 DO REQ^ASULDIRR(ASUX("REQ"))
+13 SET ASUQA("USR")=ASUL(19,"USR")_" - "_ASUL(19,"USR","NM")
+14 SET ASUQ=^XTMP("ASUR","R82",ASUX("ARST"),ASUX("ACIX"),ASUX("REQ"))
+15 SET $PIECE(ASUQA(0,ASUX("SST")),U)=$PIECE(ASUQ,U)
+16 SET $PIECE(ASUQA(0,ASUX("SST")),U,2)=$PIECE(ASUQ,U,2)
+17 SET $PIECE(ASUQA(0,ASUX("SST")),U,3)=$FNUMBER(($PIECE(ASUQ,U,2)/ASUQA("DIV")),"",2)
+18 SET $PIECE(ASUQA(0,ASUX("SST")),U,4)=$PIECE(ASUQ,U,3)
+19 SET $PIECE(ASUQA(0,ASUX("SST")),U,5)=$PIECE(ASUQ,U,4)
+20 SET $PIECE(ASUQA(0,ASUX("SST")),U,6)=$FNUMBER(($PIECE(ASUQ,U,3)/ASUQA("DIV")),"",2)
+21 DO P3
+22 IF ASUF("HDR")
DO HEADER
IF $DATA(DUOUT)
QUIT
+23 WRITE !
SET ASUC("LN")=ASUC("LN")+1
+24 IF ASUF("IDX")=1
Begin DoDot:2
+25 WRITE ?10,ASUMX("DESC",2)
SET ASUF("IDX")=2
End DoDot:2
+26 IF '$TEST
IF ASUF("IDX")=0
Begin DoDot:2
+27 WRITE !
SET ASUC("LN")=ASUC("LN")+1
+28 WRITE ?1,$EXTRACT(ASUMX("IDX"),1,5)_"."_$EXTRACT(ASUMX("IDX"),6,6)
+29 WRITE ?10,ASUMX("DESC",1)
+30 WRITE ?45,ASUMX("AR U/I")
End DoDot:2
+31 SET ASUF("IDX")=1
+32 DO P2
End DoDot:1
+33 IF $DATA(DTOUT)
QUIT
IF $DATA(DUOUT)
QUIT
+34 IF ASUF("IDX")=1
WRITE !?10,ASUMX("DESC",2)
SET ASUC("LN")=ASUC("LN")+1
+35 IF ASUF("IDX")
SET ASUV("SST")=0
DO PRTOTL
+36 QUIT
P2 ;
+1 WRITE ?50,ASUL(18,"SST"),?55,ASUL(19,"USR")
PRLQTY ;
+1 FOR ASUV("PIECE")=1:1:3
Begin DoDot:1
+2 SET ASURZX=((ASUV("PIECE")-1)*10)+60
+3 SET ASURZ=$JUSTIFY($FNUMBER($PIECE(ASUQA(ASUV("LEV"),ASUX("SST")),U,ASUV("PIECE")),"+,T",0),10)
+4 DO PRCOLM
End DoDot:1
PRLVAL ;EP ; PRINT VALUES ISSUED -CUR QTR/YTD/AVERAGE
+1 FOR ASUV("PIECE")=4:1:6
Begin DoDot:1
+2 SET ASURZX=((ASUV("PIECE")-4)*12)+90
+3 SET ASURZ=$JUSTIFY($FNUMBER($PIECE(ASUQA(ASUV("LEV"),ASUX("SST")),U,ASUV("PIECE")),"+,T",2),12)
+4 DO PRCOLM
End DoDot:1
+5 IF ASUC("LN")>(IOSL-2)
SET ASUF("HDR")=1
+6 QUIT
PRCOLM ;
+1 WRITE ?ASURZX,ASURZ
+2 QUIT
PRTOTL ;PRINT TOTAL LINES
+1 IF ASUC("LN")>(IOSL-ASUV("LEV")*2)
SET ASUF("HDR")=1
+2 IF ASUF("HDR")
DO HEADER
IF $DATA(DUOUT)
QUIT
+3 WRITE !,$PIECE($TEXT(TOTNAM+ASUV("LEV")),";",4)
+4 SET ASUC("LN")=ASUC("LN")+1
+5 SET ASUV("SST")=ASUL(18,"SST","E#")
SET ASUL(18,"SST","E#")=0
+6 IF ASUV("LEV")=0
Begin DoDot:1
+7 DO PRDASH
+8 WRITE !?35,$PIECE($TEXT(TOTNAM+ASUV("LEV")),";",3)
+9 SET ASUC("LN")=ASUC("LN")+1
+10 DO PRLQTY
DO PRDDSH
End DoDot:1
+11 IF '$TEST
Begin DoDot:1
+12 SET ASUF("HDR")=1
+13 DO PRSST
+14 SET ASUL(18,"SST","E#")=0
+15 WRITE !?55,$PIECE($TEXT(TOTNAM+ASUV("LEV")),";",3)
+16 SET ASUC("LN")=ASUC("LN")+1
+17 DO PRLVAL
+18 WRITE !
DO PRDDSHV
End DoDot:1
+19 SET ASUL(18,"SST","E#")=ASUV("SST")
+20 KILL ASUQA(ASUV("LEV"))
+21 QUIT
PRDASH ;
+1 FOR ASUC=0:1:2
SET X=(ASUC*10)+60
WRITE ?X," _________"
PRDASHV ;
+1 FOR ASUC=0:1:2
SET X=(ASUC*12)+90
WRITE ?X," ___________",?1,""
+2 SET ASUC("LN")=ASUC("LN")+1
+3 QUIT
PRDDSH ;
+1 WRITE !
+2 FOR ASUC=0:1:2
SET X=(ASUC*10)+60
WRITE ?X," ========="
PRDDSHV ;
+1 FOR ASUC=0:1:2
SET X=(ASUC*12)+90
WRITE ?X," ===========",?1,""
+2 SET ASUC("LN")=ASUC("LN")+1
+3 QUIT
+1 SET ASUV("SST")=0
+2 FOR
SET ASUV("SST")=$ORDER(ASUQA(ASUV("LEV"),ASUV("SST")))
IF ASUV("SST")=""
QUIT
Begin DoDot:1
+3 WRITE !?50,$EXTRACT(ASUV("SST"),4,5)
+4 WRITE ?55,$PIECE($TEXT(TOTNAM+ASUV("LEV")),";",3)
+5 DO PRLVAL
End DoDot:1
+6 WRITE !
DO PRDASHV
+7 QUIT
+1 SET ASUC("PG")=ASUC("PG")+1
+2 IF ASUC("PG")>1
DO PAZ^ASUURHDR
IF $DATA(DUOUT)
QUIT
+3 WRITE @IOF,!,"REPORT #82 QUARTERLY LISTING OF YEARLY ITEMS",?70,"DATE : ",ASUV("DT"),?95,"PAGE :",$JUSTIFY(ASUC("PG"),3)
+4 WRITE !,"AREA: ",ASUQA("AR"),?50,$SELECT(ASUT("QTR")="04":"LAST",ASUT("QTR")="03":"THIRD",ASUT("QTR")="02":"SECOND",1:"1ST")," QUARTER OF FISCAL YEAR ",ASUP("YR")
+5 WRITE !,"STAT: ",ASUQA("STA"),?53,"GL ACCOUNT : ",ASUQA("ACC")
+6 WRITE !!?68,"QUANTITY ISSUED",?96,"ISSUE VALUE ISSUE VALUE"
+7 WRITE !?3,"INDEX ITEM",?45,"U",?49,"SUB",?55,"USER",?64,"CURRENT",?83,"MONTHLY",?96,"CURRENT",?119,"MONTHLY"
+8 WRITE !?2,"NUMBER DESCRIPTION",?46,"I",?49,"STA",?55,"CODE",?64,"QUARTER",?76,"Y-T-D",?83,"AVERAGE",?96,"QUARTER",?110,"Y-T-D",?119,"AVERAGE"
+9 WRITE !
FOR ASUC=1:1:132
WRITE "_"
+10 WRITE !!
+11 SET ASUC("LN")=10
SET ASUF("HDR")=0
+12 QUIT
TOTNAM ;;ITEM TOTAL
+1 ;;GL ACCOUNT TOTAL VALUE;SUMMARY OF YEARLY ITEMS BY ACCOUNT
+2 ;;TOTAL VALUE YEARLY ITEMS;SUMMARY OF TOTAL VALUE YEARLY ITEMS
P3 ;
+1 FOR ASUV("PIECE")=1:1:6
Begin DoDot:1
+2 SET ASUQA(0,0)=$GET(ASUQA(0,0))
+3 SET $PIECE(ASUQA(0,0),U,ASUV("PIECE"))=$PIECE(ASUQA(0,0),U,ASUV("PIECE"))+$PIECE(ASUQA(0,ASUX("SST")),U,ASUV("PIECE"))
End DoDot:1
+4 FOR ASUV("LEVA")=0:1:2
Begin DoDot:1
+5 FOR ASUV("PIECE")=1:1:6
Begin DoDot:2
+6 SET ASUQA(ASUV("LEVA")+1,ASUX("SST"))=$GET(ASUQA(ASUV("LEVA")+1,ASUX("SST")))
+7 SET $PIECE(ASUQA(ASUV("LEVA")+1,ASUX("SST")),U,ASUV("PIECE"))=$PIECE(ASUQA(ASUV("LEVA")+1,ASUX("SST")),U,ASUV("PIECE"))+$PIECE(ASUQA(ASUV("LEVA"),ASUX("SST")),U,ASUV("PIECE"))
+8 SET ASUQA(ASUV("LEVA")+1,0)=$GET(ASUQA(ASUV("LEVA")+1,0))
+9 SET $PIECE(ASUQA(ASUV("LEVA")+1,0),U,ASUV("PIECE"))=$PIECE(ASUQA(ASUV("LEVA")+1,0),U,ASUV("PIECE"))+$PIECE(ASUQA(ASUV("LEVA"),ASUX("SST")),U,ASUV("PIECE"))
End DoDot:2
End DoDot:1
+10 QUIT
