ASURMBSP ; IHS/ITSC/LMH -PRINT BALANCE SHEETS ;
;;4.2T2;Supply Accounting Mgmt. System;;JUN 30, 2000
;This routine formats and prints the Balance Sheet report
EN1 ;
I '$D(DUZ(2)) W !,"Report must be run from Kernel option" Q
I '$D(IO) D HOME^%ZIS
D:'$D(U) ^XBKVAR
D:'$D(ASUK("DT","FM")) DATE^ASUUDATE
I '$D(ASUL(1,"AR","AP")) D SETAREA^ASULARST
S ASUK("PTRSEL")=$G(ASUK("PTRSEL"))
I ASUK("PTRSEL")']"" D
.S ZTRTN="PSER^ASUMBSP",ZTDESC="SAMS BALANCE SHEETS" D O^ASUUZIS
.I POP S IOP=$I D ^%ZIS
I '$D(ASUK(ASUK("PTR"),"Q")) Q
I ASUK(ASUK("PTR"),"Q") Q
PSER ;EP;FOR TASKMAN QUEUE OF PRINT
D U^ASUUZIS
S ASUC("LN")=IOSL+1,ASUC("PG")=2
D ASUMBSP1,ASUMBSP2 S ASUMC=3 D ASUMBSP3 S ASUMC=4 D ASUMBSP3
K ASUX
I ASUK("PTRSEL")]"" Q
D C^ASUUZIS
Q
EN2 ;EP ; SELECT DATE
W !,"ENTER BALANCE SHEET DATE"
D ASKDATE^ASUUDATE
G EN1
ASUMBSP1 ;
S ASUT="BAL"
S ASUMC("ACC")=0,ASUX("TOT")=""
D HDR1
F S ASUMC("ACC")=$O(^ASUMC(ASUL(2,"STA","E#"),1,ASUK("DT","FYM#"),1,ASUMC("ACC"))) Q:ASUMC("ACC")'?1N.N D
.N X,Y
.S X=^ASUMC(ASUL(2,"STA","E#"),1,ASUK("DT","FYM#"),1,ASUMC("ACC"),0)
.S ASUT(0)=$P(X,U,2)
.S ASUT(0)=ASUT(0)_U_($P(X,U,3)+$P(X,U,4)+$P(X,U,5))
.S ASUT(0)=ASUT(0)_U_($P(X,U,6)+$P(X,U,7)+$P(X,U,8))
.S ASUT(0)=ASUT(0)_U_$P(X,U,9)
.S ASUT(0)=ASUT(0)_U_$P(X,U,10)_U_$P(X,U,11)_U
.F Y=1:1:4 S $P(ASUT(0),U,7)=$P(ASUT(0),U,7)+$P(ASUT(0),U,Y)
.S $P(ASUT(0),U,7)=$P(ASUT(0),U,7)-$P(ASUT(0),U,5)
.W !!,"125.",ASUMC("ACC")
.N X F X=1:1:6 D
..S Y=$P(ASUT(0),U,X),Y=$S(Y']"":Y,Y=0:"",1:$J($FN(Y,"P,",2),12))
..W ?X*15,Y
..S $P(ASUX("TOT"),U,X)=$P(ASUX("TOT"),U,X)+$P(ASUT(0),U,X)
.W:$P(ASUT(0),U,7)'=0 ?105,"**",$J($FN($P(ASUT(0),U,7),"P,",2),12),"OUTBAL**"
D DASH
W !,"TOTAL"
F X=1:1:5 D
.S Y=$P(ASUX("TOT"),U,X),Y=$S(Y']"":Y,1:$J($FN(Y,"P,",2),12))
.W ?X*15,Y
Q
HDR1 ;
D CLS^ASUUHDG
W "SAMS MONTHLY BALANCE SHEET -ACCOUNT BALANCES",?60,ASUK("DT","MONTH")," ",ASUK("DT","YEAR"),?100,"PAGE 1",!!
W "ACCT# OPENING BALANCE RECEIPTS ISSUES ADJUSTMENTS CLOSING BALANCE DIRECT ISSUES"
DASH ;
W !,"_____ ____________ ____________ ____________ ____________ ____________ ____________",!!
Q
ASUMBSP2 ;
S (ASUMC("VOU"),ASUX("TOT"))=0,ASUC("LN")=ASUK(ASUK("PTR"),"IOSL")+1
F S ASUMC("VOU")=$O(^ASUMC(ASUL(2,"STA","E#"),1,ASUK("DT","FYM#"),2,ASUMC("VOU"))) Q:ASUMC("VOU")'?1N.N D
.S ASUT(ASUT,"VOU")=$P(^ASUMC(ASUL(2,"STA","E#"),1,ASUK("DT","FYM#"),2,ASUMC("VOU"),0),U)
.S ASUC("LN")=ASUC("LN")+1 D:ASUC("LN")>ASUK(ASUK("PTR"),"IOSL") HDR2
.W !,ASUT(ASUT,"VOU")
.S Z=0
.F X=1:1:5,9 D
..S Z=Z+1
..S ASUT(0)=$G(^ASUMC(ASUL(2,"STA","E#"),1,ASUK("DT","FYM#"),2,ASUMC("VOU"),1,X,0))
..S Y=$J($FN($P(ASUT(0),U,2),",",2),12)
..W:Y'["0.00" ?Z*15,Y
..S $P(ASUX("TOT"),U,X)=$P(ASUX("TOT"),U,X)+$P(ASUT(0),U,2)
D DASH2
W !,"TOTAL"
S Z=0
F X=1:1:5,9 D
.S Z=Z+1
.S Y=$P(ASUX("TOT"),U,X),Y=$S(Y']"":Y,0=+Y:"",1:$J($FN(Y,",",2),12))
.W ?Z*15,Y
Q
HDR2 ;
D CLS^ASUUHDG
W "SAMS MONTHLY BALANCE SHEET - RECEIPT VOUCHERS",?60,ASUK("DT","MONTH")," ",ASUK("DT","YEAR"),?100,"PAGE ",ASUC("PG"),!!
W "VOUCHER # 125.1 125.2 125.3 125.4 125.5 125.9"
S ASUC("PG")=ASUC("PG")+1,ASUC("LN")=3
DASH2 ;
W !,"____________ ____________ ____________ ____________ ____________ ____________ ____________",!!
Q
ASUMBSP3 ;
S (ASUMC("CAN"),ASUX("TOT"))=0,ASUC("LN")=ASUK(ASUK("PTR"),"IOSL")+1
F S ASUMC("CAN")=$O(^ASUMC(ASUL(2,"STA","E#"),1,ASUK("DT","FYM#"),ASUMC,ASUMC("CAN"))) Q:ASUMC("CAN")'?1N.N D
.S ASUT(ASUT,"CAN")=$P(^ASUMC(ASUL(2,"STA","E#"),1,ASUK("DT","FYM#"),ASUMC,ASUMC("CAN"),0),U)
.S ASUC("LN")=ASUC("LN")+1 D:ASUC("LN")>ASUK(ASUK("PTR"),"IOSL") HDR3
.W !,$S(ASUT(ASUT,"CAN")=" ":"UNKNOWN",1:ASUT(ASUT,"CAN"))
.S Z=0,ASUX=0
.F X=1:1:5,9 D
..S Z=Z+1
..S ASUT(0)=$G(^ASUMC(ASUL(2,"STA","E#"),1,ASUK("DT","FYM#"),ASUMC,ASUMC("CAN"),1,X,0))
..S Y=$J($FN($P(ASUT(0),U,2),"P,",2),12)
..W:Y'["0.00" ?Z*15,Y
..S $P(ASUX("TOT"),U,X)=$P(ASUX("TOT"),U,X)-$P(ASUT(0),U,2)
..S ASUX=ASUX-$P(ASUT(0),U,X)
.W ?105,$J($FN(ASUX,"P,",2),12)
D DASH3
W !,"TOTAL"
S Z=0,ASUX=0
F X=1:1:5,9 D
.S Z=Z+1
.S Y=$P(ASUX("TOT"),U,X),Y=$S(Y']"":Y,Y=0:"",1:$J($FN(Y,",",2),12))
.W:Z'="0.00" ?Z*15,Y
.S ASUX=ASUX+$P(ASUX("TOT"),U,X)
W ?105,$J($FN(ASUX,",",2),12)
Q
HDR3 ;
D CLS^ASUUHDG
W "SAMS MONTHLY BALANCE SHEET -",$S(ASUMC=3:"ISS",1:"DIR")," CANS ",?60,ASUK("DT","MONTH")," ",ASUK("DT","YEAR"),?100,"PAGE ",ASUC("PG"),!!
W "CAN NUMBER 125.1 125.2 125.3 125.4 125.5 125.9 TOTAL"
S ASUC("PG")=ASUC("PG")+1,ASUC("LN")=3
DASH3 ;
W !,"____________ ____________ ____________ ____________ ____________ ____________ ____________ ____________",!!
Q
ASURMBSP ; IHS/ITSC/LMH -PRINT BALANCE SHEETS ;
+1 ;;4.2T2;Supply Accounting Mgmt. System;;JUN 30, 2000
+2 ;This routine formats and prints the Balance Sheet report
EN1 ;
+1 IF '$DATA(DUZ(2))
WRITE !,"Report must be run from Kernel option"
QUIT
+2 IF '$DATA(IO)
DO HOME^%ZIS
+3 IF '$DATA(U)
DO ^XBKVAR
+4 IF '$DATA(ASUK("DT","FM"))
DO DATE^ASUUDATE
+5 IF '$DATA(ASUL(1,"AR","AP"))
DO SETAREA^ASULARST
+6 SET ASUK("PTRSEL")=$GET(ASUK("PTRSEL"))
+7 IF ASUK("PTRSEL")']""
Begin DoDot:1
+8 SET ZTRTN="PSER^ASUMBSP"
SET ZTDESC="SAMS BALANCE SHEETS"
DO O^ASUUZIS
+9 IF POP
SET IOP=$IO
DO ^%ZIS
End DoDot:1
+10 IF '$DATA(ASUK(ASUK("PTR"),"Q"))
QUIT
+11 IF ASUK(ASUK("PTR"),"Q")
QUIT
PSER ;EP;FOR TASKMAN QUEUE OF PRINT
+1 DO U^ASUUZIS
+2 SET ASUC("LN")=IOSL+1
SET ASUC("PG")=2
+3 DO ASUMBSP1
DO ASUMBSP2
SET ASUMC=3
DO ASUMBSP3
SET ASUMC=4
DO ASUMBSP3
+4 KILL ASUX
+5 IF ASUK("PTRSEL")]""
QUIT
+6 DO C^ASUUZIS
+7 QUIT
EN2 ;EP ; SELECT DATE
+1 WRITE !,"ENTER BALANCE SHEET DATE"
+2 DO ASKDATE^ASUUDATE
+3 GOTO EN1
ASUMBSP1 ;
+1 SET ASUT="BAL"
+2 SET ASUMC("ACC")=0
SET ASUX("TOT")=""
+3 DO HDR1
+4 FOR
SET ASUMC("ACC")=$ORDER(^ASUMC(ASUL(2,"STA","E#"),1,ASUK("DT","FYM#"),1,ASUMC("ACC")))
IF ASUMC("ACC")'?1N.N
QUIT
Begin DoDot:1
+5 NEW X,Y
+6 SET X=^ASUMC(ASUL(2,"STA","E#"),1,ASUK("DT","FYM#"),1,ASUMC("ACC"),0)
+7 SET ASUT(0)=$PIECE(X,U,2)
+8 SET ASUT(0)=ASUT(0)_U_($PIECE(X,U,3)+$PIECE(X,U,4)+$PIECE(X,U,5))
+9 SET ASUT(0)=ASUT(0)_U_($PIECE(X,U,6)+$PIECE(X,U,7)+$PIECE(X,U,8))
+10 SET ASUT(0)=ASUT(0)_U_$PIECE(X,U,9)
+11 SET ASUT(0)=ASUT(0)_U_$PIECE(X,U,10)_U_$PIECE(X,U,11)_U
+12 FOR Y=1:1:4
SET $PIECE(ASUT(0),U,7)=$PIECE(ASUT(0),U,7)+$PIECE(ASUT(0),U,Y)
+13 SET $PIECE(ASUT(0),U,7)=$PIECE(ASUT(0),U,7)-$PIECE(ASUT(0),U,5)
+14 WRITE !!,"125.",ASUMC("ACC")
+15 NEW X
FOR X=1:1:6
Begin DoDot:2
+16 SET Y=$PIECE(ASUT(0),U,X)
SET Y=$SELECT(Y']"":Y,Y=0:"",1:$JUSTIFY($FNUMBER(Y,"P,",2),12))
+17 WRITE ?X*15,Y
+18 SET $PIECE(ASUX("TOT"),U,X)=$PIECE(ASUX("TOT"),U,X)+$PIECE(ASUT(0),U,X)
End DoDot:2
+19 IF $PIECE(ASUT(0),U,7)'=0
WRITE ?105,"**",$JUSTIFY($FNUMBER($PIECE(ASUT(0),U,7),"P,",2),12),"OUTBAL**"
End DoDot:1
+20 DO DASH
+21 WRITE !,"TOTAL"
+22 FOR X=1:1:5
Begin DoDot:1
+23 SET Y=$PIECE(ASUX("TOT"),U,X)
SET Y=$SELECT(Y']"":Y,1:$JUSTIFY($FNUMBER(Y,"P,",2),12))
+24 WRITE ?X*15,Y
End DoDot:1
+25 QUIT
HDR1 ;
+1 DO CLS^ASUUHDG
+2 WRITE "SAMS MONTHLY BALANCE SHEET -ACCOUNT BALANCES",?60,ASUK("DT","MONTH")," ",ASUK("DT","YEAR"),?100,"PAGE 1",!!
+3 WRITE "ACCT# OPENING BALANCE RECEIPTS ISSUES ADJUSTMENTS CLOSING BALANCE DIRECT ISSUES"
DASH ;
+1 WRITE !,"_____ ____________ ____________ ____________ ____________ ____________ ____________",!!
+2 QUIT
ASUMBSP2 ;
+1 SET (ASUMC("VOU"),ASUX("TOT"))=0
SET ASUC("LN")=ASUK(ASUK("PTR"),"IOSL")+1
+2 FOR
SET ASUMC("VOU")=$ORDER(^ASUMC(ASUL(2,"STA","E#"),1,ASUK("DT","FYM#"),2,ASUMC("VOU")))
IF ASUMC("VOU")'?1N.N
QUIT
Begin DoDot:1
+3 SET ASUT(ASUT,"VOU")=$PIECE(^ASUMC(ASUL(2,"STA","E#"),1,ASUK("DT","FYM#"),2,ASUMC("VOU"),0),U)
+4 SET ASUC("LN")=ASUC("LN")+1
IF ASUC("LN")>ASUK(ASUK("PTR"),"IOSL")
DO HDR2
+5 WRITE !,ASUT(ASUT,"VOU")
+6 SET Z=0
+7 FOR X=1:1:5,9
Begin DoDot:2
+8 SET Z=Z+1
+9 SET ASUT(0)=$GET(^ASUMC(ASUL(2,"STA","E#"),1,ASUK("DT","FYM#"),2,ASUMC("VOU"),1,X,0))
+10 SET Y=$JUSTIFY($FNUMBER($PIECE(ASUT(0),U,2),",",2),12)
+11 IF Y'["0.00"
WRITE ?Z*15,Y
+12 SET $PIECE(ASUX("TOT"),U,X)=$PIECE(ASUX("TOT"),U,X)+$PIECE(ASUT(0),U,2)
End DoDot:2
End DoDot:1
+13 DO DASH2
+14 WRITE !,"TOTAL"
+15 SET Z=0
+16 FOR X=1:1:5,9
Begin DoDot:1
+17 SET Z=Z+1
+18 SET Y=$PIECE(ASUX("TOT"),U,X)
SET Y=$SELECT(Y']"":Y,0=+Y:"",1:$JUSTIFY($FNUMBER(Y,",",2),12))
+19 WRITE ?Z*15,Y
End DoDot:1
+20 QUIT
HDR2 ;
+1 DO CLS^ASUUHDG
+2 WRITE "SAMS MONTHLY BALANCE SHEET - RECEIPT VOUCHERS",?60,ASUK("DT","MONTH")," ",ASUK("DT","YEAR"),?100,"PAGE ",ASUC("PG"),!!
+3 WRITE "VOUCHER # 125.1 125.2 125.3 125.4 125.5 125.9"
+4 SET ASUC("PG")=ASUC("PG")+1
SET ASUC("LN")=3
DASH2 ;
+1 WRITE !,"____________ ____________ ____________ ____________ ____________ ____________ ____________",!!
+2 QUIT
ASUMBSP3 ;
+1 SET (ASUMC("CAN"),ASUX("TOT"))=0
SET ASUC("LN")=ASUK(ASUK("PTR"),"IOSL")+1
+2 FOR
SET ASUMC("CAN")=$ORDER(^ASUMC(ASUL(2,"STA","E#"),1,ASUK("DT","FYM#"),ASUMC,ASUMC("CAN")))
IF ASUMC("CAN")'?1N.N
QUIT
Begin DoDot:1
+3 SET ASUT(ASUT,"CAN")=$PIECE(^ASUMC(ASUL(2,"STA","E#"),1,ASUK("DT","FYM#"),ASUMC,ASUMC("CAN"),0),U)
+4 SET ASUC("LN")=ASUC("LN")+1
IF ASUC("LN")>ASUK(ASUK("PTR"),"IOSL")
DO HDR3
+5 WRITE !,$SELECT(ASUT(ASUT,"CAN")=" ":"UNKNOWN",1:ASUT(ASUT,"CAN"))
+6 SET Z=0
SET ASUX=0
+7 FOR X=1:1:5,9
Begin DoDot:2
+8 SET Z=Z+1
+9 SET ASUT(0)=$GET(^ASUMC(ASUL(2,"STA","E#"),1,ASUK("DT","FYM#"),ASUMC,ASUMC("CAN"),1,X,0))
+10 SET Y=$JUSTIFY($FNUMBER($PIECE(ASUT(0),U,2),"P,",2),12)
+11 IF Y'["0.00"
WRITE ?Z*15,Y
+12 SET $PIECE(ASUX("TOT"),U,X)=$PIECE(ASUX("TOT"),U,X)-$PIECE(ASUT(0),U,2)
+13 SET ASUX=ASUX-$PIECE(ASUT(0),U,X)
End DoDot:2
+14 WRITE ?105,$JUSTIFY($FNUMBER(ASUX,"P,",2),12)
End DoDot:1
+15 DO DASH3
+16 WRITE !,"TOTAL"
+17 SET Z=0
SET ASUX=0
+18 FOR X=1:1:5,9
Begin DoDot:1
+19 SET Z=Z+1
+20 SET Y=$PIECE(ASUX("TOT"),U,X)
SET Y=$SELECT(Y']"":Y,Y=0:"",1:$JUSTIFY($FNUMBER(Y,",",2),12))
+21 IF Z'="0.00"
WRITE ?Z*15,Y
+22 SET ASUX=ASUX+$PIECE(ASUX("TOT"),U,X)
End DoDot:1
+23 WRITE ?105,$JUSTIFY($FNUMBER(ASUX,",",2),12)
+24 QUIT
HDR3 ;
+1 DO CLS^ASUUHDG
+2 WRITE "SAMS MONTHLY BALANCE SHEET -",$SELECT(ASUMC=3:"ISS",1:"DIR")," CANS ",?60,ASUK("DT","MONTH")," ",ASUK("DT","YEAR"),?100,"PAGE ",ASUC("PG"),!!
+3 WRITE "CAN NUMBER 125.1 125.2 125.3 125.4 125.5 125.9 TOTAL"
+4 SET ASUC("PG")=ASUC("PG")+1
SET ASUC("LN")=3
DASH3 ;
+1 WRITE !,"____________ ____________ ____________ ____________ ____________ ____________ ____________ ____________",!!
+2 QUIT
