ASURD10V ; IHS/ITSC/LMH -RPT 10 -VOUCHER SUMMARY ;
;;4.2T2;Supply Accounting Mgmt. System;;JUN 30, 2000
;This routine formats and prints report 10A, Voucher Summary.
EN ;EP;PRIMARY ENTRY POINT FOR REPORT 10V
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^ASURD10V",ZTDESC="SAMS RPT 10V" D O^ASUUZIS
I POP S IOP=$I D ^%ZIS Q
I ASUK(ASUK("PTR"),"Q") Q
PSER ;EP;FOR TASKMAN QUEUE OF PRINT
D:'$D(^XTMP("ASUR","R10V")) CMPT D U^ASUUZIS
S ASUV("RPT")="R10V",ASUQ("HDR")="HEADER^ASURD10V" D ^ASUUDATA I ASUX("NDTA") G K
S (X1,ASUX("IX"),ASUX("VO"),ASUX("SQ"))="",(ASUF("COL"),ASUC("TOT"),ASUC("TOT","VAL"))=0
F S ASUX("AS")=$O(^XTMP("ASUR","R10V",ASUX("AS"))) Q:ASUX("AS")="" D Q:$D(DUOUT)
.I ASUV("ARST")'=ASUX("AS") D HEADER Q:$D(DUOUT)
.S ASUV("ARST")=ASUX("AS")
.F S ASUX("VO")=$O(^XTMP("ASUR","R10V",ASUX("AS"),ASUX("VO"))) Q:ASUX("VO")="" D Q:$D(DUOUT)
..D:ASUC("LN")>(IOSL-6) HEADER Q:$D(DUOUT)
..D VHEAD
..F S ASUX("IX")=$O(^XTMP("ASUR","R10V",ASUX("AS"),ASUX("VO"),ASUX("IX"))) Q:ASUX("IX")="" D
...F S ASUX("SQ")=$O(^XTMP("ASUR","R10V",ASUX("AS"),ASUX("VO"),ASUX("IX"),ASUX("SQ"))) Q:ASUX("SQ")="" D V1
..I ASUF("COL")>0 W ! S ASUC("LN")=ASUC("LN")+1
..W ?2,"NUMBER LINE ITEMS: ",$J($FN(ASUC("TOT"),",",0),6)
..W ?28,"TOTAL VALUE: $ ",$J($FN(ASUC("TOT","VAL"),",",2),12),! S ASUC("LN")=ASUC("LN")+1
..S (ASUC("TOT"),ASUC("TOT","VAL"),ASUF("COL"))=0
.S ASUC("LN")=IOSL+1
K ;
K ASUX,ASUV,ASUC,ASUQ D PAZ^ASUURHDR I ASUK("PTRSEL")]"" W @IOF Q
D C^ASUUZIS Q
CMPT ;EP;COMPUTE REPORT CONTENTS
K ^XTMP("ASUR","R10V") S ^XTMP("ASUR","R10V",0)=ASUK("DT","FM")+10000_U_ASUK("DT","FM")
D:$G(ASUN("TYP"))']"" ^ASUURANG
S ASUHDA=$G(ASUN("B#"))-1
F S ASUHDA=$O(^ASUH(ASUHDA)) Q:ASUHDA>$G(ASUN("E#")) Q:ASUHDA'?1N.N D
.Q:ASUHDA=0
.D READ^ASU0TRRD(.ASUHDA,"H") Q:$G(ASUT)']"" Q:ASUT(ASUT,"VOU")']""
.;WAR 4/14/99 temp fix need to add this to list
.I $E(ASUT,1,2)="DI" S ASUT(ASUT,"PT","IDX")=ASUT(ASUT,"AR")_"999998"
.S ^XTMP("ASUR","R10V",ASUT(ASUT,"PT","STA"),ASUT(ASUT,"VOU"),ASUT(ASUT,"PT","IDX"),ASUHDA)=ASUHDA
Q
S ASUC("PG")=$G(ASUC("PG"))+1 I ASUC("PG")>1 D PAZ^ASUURHDR Q:$D(DUOUT) W @IOF
W !?5,"REPORT #10. DAILY VOUCHER LISTING"
W ?100,"DATE: ",ASUX("DT"),?120,"PAGE: ",ASUC("PG")
S X=ASUL(1,"AR","AP") W !?3,"AREA: ",ASUL(1,"AR","AP"),?15,ASUL(1,"AR","NM")
I ASUX("AS")'=$G(ASUL(2,"STA","E#")) D STA^ASULARST(ASUX("AS"))
W !?3,"STATION: ",$G(ASUL(2,"STA","CD")),?15,$G(ASUL(2,"STA","NM"))
W !!?35,"F",?73,"F",?111,"F",!?3,"TR",?9,"INDEX",?35,"P",?41,"TR",?46,"INDEX",?73,"P",?79,"TR",?85,"INDEX",?111,"P"
W !?3,"CD",?8,"NUMBER",?19,"QTY",?28,"VALUE",?35,"N",?41,"CD",?45,"NUMBER",?57,"QTY",?66,"VALUE",?73,"N",?79,"CD",?84,"NUMBER",?95,"QTY",?104,"VALUE",?111,"N"
W !,"------------------------------------------------------------------------------------------------------------------------------------",!
S ASUC("LN")=9
Q
VHEAD ;PRINT VOUCHER HEADING LINE
W !?2,"VOUCHER NO: ",$G(ASUX("VO")),! S ASUC("LN")=ASUC("LN")+2 Q
V1 ;
S ASUHDA=(^XTMP("ASUR","R10V",ASUX("AS"),ASUX("VO"),ASUX("IX"),ASUX("SQ"))) K ASUT D READ^ASU0TRRD(.ASUHDA,"H") Q:$G(ASUT)']""
D:ASUC("LN")>(IOSL-2) HEADER,VHEAD
I $E(ASUT("TRCD"),2,2)?1N S ASUC("TOT","VAL")=ASUC("TOT","VAL")+ASUT(ASUT,"VAL"),ASUC("TOT")=ASUC("TOT")+1
I ASUF("COL")=0 D Q
.W ?3,ASUT("TRCD"),?7,$E(ASUT(ASUT,"IDX"),1,5),".",$E(ASUT(ASUT,"IDX"),6,6),?16,$J($FN(ASUT(ASUT,"QTY"),",",0),6),?23,$J($FN(ASUT(ASUT,"VAL"),",",2),10),?35,ASUT(ASUT,"FPN")
.S ASUF("COL")=1 ;S ASUC("LN")=ASUC("LN")+1
I ASUF("COL")=1 D Q
.W ?41,ASUT("TRCD"),?46,$E(ASUT(ASUT,"IDX"),1,5),".",$E(ASUT(ASUT,"IDX"),6,6),?54,$J($FN(ASUT(ASUT,"QTY"),",",0),6),?61,$J($FN(ASUT(ASUT,"VAL"),",",2),10),?73,ASUT(ASUT,"FPN")
.S ASUF("COL")=2
W ?79,ASUT("TRCD"),?83,$E(ASUT(ASUT,"IDX"),1,5),".",$E(ASUT(ASUT,"IDX"),6,6),?92,$J($FN(ASUT(ASUT,"QTY"),",",0),6),?99,$J($FN(ASUT(ASUT,"VAL"),",",2),10),?111,ASUT(ASUT,"FPN"),! S ASUC("LN")=ASUC("LN")+1
S ASUF("COL")=0
Q
ASURD10V ; IHS/ITSC/LMH -RPT 10 -VOUCHER SUMMARY ;
+1 ;;4.2T2;Supply Accounting Mgmt. System;;JUN 30, 2000
+2 ;This routine formats and prints report 10A, Voucher Summary.
EN ;EP;PRIMARY ENTRY POINT FOR REPORT 10V
+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^ASURD10V"
SET ZTDESC="SAMS RPT 10V"
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 IF '$DATA(^XTMP("ASUR","R10V"))
DO CMPT
DO U^ASUUZIS
+2 SET ASUV("RPT")="R10V"
SET ASUQ("HDR")="HEADER^ASURD10V"
DO ^ASUUDATA
IF ASUX("NDTA")
GOTO K
+3 SET (X1,ASUX("IX"),ASUX("VO"),ASUX("SQ"))=""
SET (ASUF("COL"),ASUC("TOT"),ASUC("TOT","VAL"))=0
+4 FOR
SET ASUX("AS")=$ORDER(^XTMP("ASUR","R10V",ASUX("AS")))
IF ASUX("AS")=""
QUIT
Begin DoDot:1
+5 IF ASUV("ARST")'=ASUX("AS")
DO HEADER
IF $DATA(DUOUT)
QUIT
+6 SET ASUV("ARST")=ASUX("AS")
+7 FOR
SET ASUX("VO")=$ORDER(^XTMP("ASUR","R10V",ASUX("AS"),ASUX("VO")))
IF ASUX("VO")=""
QUIT
Begin DoDot:2
+8 IF ASUC("LN")>(IOSL-6)
DO HEADER
IF $DATA(DUOUT)
QUIT
+9 DO VHEAD
+10 FOR
SET ASUX("IX")=$ORDER(^XTMP("ASUR","R10V",ASUX("AS"),ASUX("VO"),ASUX("IX")))
IF ASUX("IX")=""
QUIT
Begin DoDot:3
+11 FOR
SET ASUX("SQ")=$ORDER(^XTMP("ASUR","R10V",ASUX("AS"),ASUX("VO"),ASUX("IX"),ASUX("SQ")))
IF ASUX("SQ")=""
QUIT
DO V1
End DoDot:3
+12 IF ASUF("COL")>0
WRITE !
SET ASUC("LN")=ASUC("LN")+1
+13 WRITE ?2,"NUMBER LINE ITEMS: ",$JUSTIFY($FNUMBER(ASUC("TOT"),",",0),6)
+14 WRITE ?28,"TOTAL VALUE: $ ",$JUSTIFY($FNUMBER(ASUC("TOT","VAL"),",",2),12),!
SET ASUC("LN")=ASUC("LN")+1
+15 SET (ASUC("TOT"),ASUC("TOT","VAL"),ASUF("COL"))=0
End DoDot:2
IF $DATA(DUOUT)
QUIT
+16 SET ASUC("LN")=IOSL+1
End DoDot:1
IF $DATA(DUOUT)
QUIT
K ;
+1 KILL ASUX,ASUV,ASUC,ASUQ
DO PAZ^ASUURHDR
IF ASUK("PTRSEL")]""
WRITE @IOF
QUIT
+2 DO C^ASUUZIS
QUIT
CMPT ;EP;COMPUTE REPORT CONTENTS
+1 KILL ^XTMP("ASUR","R10V")
SET ^XTMP("ASUR","R10V",0)=ASUK("DT","FM")+10000_U_ASUK("DT","FM")
+2 IF $GET(ASUN("TYP"))']""
DO ^ASUURANG
+3 SET ASUHDA=$GET(ASUN("B#"))-1
+4 FOR
SET ASUHDA=$ORDER(^ASUH(ASUHDA))
IF ASUHDA>$GET(ASUN("E#"))
QUIT
IF ASUHDA'?1N.N
QUIT
Begin DoDot:1
+5 IF ASUHDA=0
QUIT
+6 DO READ^ASU0TRRD(.ASUHDA,"H")
IF $GET(ASUT)']""
QUIT
IF ASUT(ASUT,"VOU")']""
QUIT
+7 ;WAR 4/14/99 temp fix need to add this to list
+8 IF $EXTRACT(ASUT,1,2)="DI"
SET ASUT(ASUT,"PT","IDX")=ASUT(ASUT,"AR")_"999998"
+9 SET ^XTMP("ASUR","R10V",ASUT(ASUT,"PT","STA"),ASUT(ASUT,"VOU"),ASUT(ASUT,"PT","IDX"),ASUHDA)=ASUHDA
End DoDot:1
+10 QUIT
+1 SET ASUC("PG")=$GET(ASUC("PG"))+1
IF ASUC("PG")>1
DO PAZ^ASUURHDR
IF $DATA(DUOUT)
QUIT
WRITE @IOF
+2 WRITE !?5,"REPORT #10. DAILY VOUCHER LISTING"
+3 WRITE ?100,"DATE: ",ASUX("DT"),?120,"PAGE: ",ASUC("PG")
+4 SET X=ASUL(1,"AR","AP")
WRITE !?3,"AREA: ",ASUL(1,"AR","AP"),?15,ASUL(1,"AR","NM")
+5 IF ASUX("AS")'=$GET(ASUL(2,"STA","E#"))
DO STA^ASULARST(ASUX("AS"))
+6 WRITE !?3,"STATION: ",$GET(ASUL(2,"STA","CD")),?15,$GET(ASUL(2,"STA","NM"))
+7 WRITE !!?35,"F",?73,"F",?111,"F",!?3,"TR",?9,"INDEX",?35,"P",?41,"TR",?46,"INDEX",?73,"P",?79,"TR",?85,"INDEX",?111,"P"
+8 WRITE !?3,"CD",?8,"NUMBER",?19,"QTY",?28,"VALUE",?35,"N",?41,"CD",?45,"NUMBER",?57,"QTY",?66,"VALUE",?73,"N",?79,"CD",?84,"NUMBER",?95,"QTY",?104,"VALUE",?111,"N"
+9 WRITE !,"------------------------------------------------------------------------------------------------------------------------------------",!
+10 SET ASUC("LN")=9
+11 QUIT
VHEAD ;PRINT VOUCHER HEADING LINE
+1 WRITE !?2,"VOUCHER NO: ",$GET(ASUX("VO")),!
SET ASUC("LN")=ASUC("LN")+2
QUIT
V1 ;
+1 SET ASUHDA=(^XTMP("ASUR","R10V",ASUX("AS"),ASUX("VO"),ASUX("IX"),ASUX("SQ")))
KILL ASUT
DO READ^ASU0TRRD(.ASUHDA,"H")
IF $GET(ASUT)']""
QUIT
+2 IF ASUC("LN")>(IOSL-2)
DO HEADER
DO VHEAD
+3 IF $EXTRACT(ASUT("TRCD"),2,2)?1N
SET ASUC("TOT","VAL")=ASUC("TOT","VAL")+ASUT(ASUT,"VAL")
SET ASUC("TOT")=ASUC("TOT")+1
+4 IF ASUF("COL")=0
Begin DoDot:1
+5 WRITE ?3,ASUT("TRCD"),?7,$EXTRACT(ASUT(ASUT,"IDX"),1,5),".",$EXTRACT(ASUT(ASUT,"IDX"),6,6),?16,$JUSTIFY($FNUMBER(ASUT(ASUT,"QTY"),",",0),6),?23,$JUSTIFY($FNUMBER(ASUT(ASUT,"VAL"),",",2),10),?35,ASUT(ASUT,"FPN")
+6 ;S ASUC("LN")=ASUC("LN")+1
SET ASUF("COL")=1
End DoDot:1
QUIT
+7 IF ASUF("COL")=1
Begin DoDot:1
+8 WRITE ?41,ASUT("TRCD"),?46,$EXTRACT(ASUT(ASUT,"IDX"),1,5),".",$EXTRACT(ASUT(ASUT,"IDX"),6,6),?54,$JUSTIFY($FNUMBER(ASUT(ASUT,"QTY"),",",0),6),?61,$JUSTIFY($FNUMBER(ASUT(ASUT,"VAL"),",",2),10),?73,ASUT(ASUT,"FPN")
+9 SET ASUF("COL")=2
End DoDot:1
QUIT
+10 WRITE ?79,ASUT("TRCD"),?83,$EXTRACT(ASUT(ASUT,"IDX"),1,5),".",$EXTRACT(ASUT(ASUT,"IDX"),6,6),?92,$JUSTIFY($FNUMBER(ASUT(ASUT,"QTY"),",",0),6),?99,$JUSTIFY($FNUMBER(ASUT(ASUT,"VAL"),",",2),10),?111,ASUT(ASUT,"FPN"),!
SET ASUC("LN")=ASUC("LN")+1
+11 SET ASUF("COL")=0
+12 QUIT
