- 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
