ASUMCUPD ; IHS/ITSC/LMH -CONTROL SHEET UPDATE ;
;;4.2T2;Supply Accounting Mgmt. System;;JUN 30, 2000
;This routine initializes Control Sheet Master for Fiscal Year Month
S:$G(ASUMC(ASUMS("E#","STA"),0))']"" ^ASUMC(ASUMS("E#","STA"),0)=ASUMS("E#","STA")
K ^ASUMC(ASUMS("E#","STA"),1,ASUK("DT","FYM#"))
S ^ASUMC(ASUMS("E#","STA"),1,ASUK("DT","FYM#"),0)=ASUK("DT","FYM#")
S:$G(ASUMC(ASUMS("E#","STA"),1,0))']"" ^ASUMC(ASUMS("E#","STA"),1,0)="^9002037.01^^"
S ^ASUMC(ASUMS("E#","STA"),1,ASUK("DT","FYM#"),1,0)="^9002037.11PA^^"
S ^ASUMC(ASUMS("E#","STA"),1,ASUK("DT","FYM#"),2,0)="^9002037.12PA^^"
S ^ASUMC(ASUMS("E#","STA"),1,ASUK("DT","FYM#"),3,0)="^9002037.13PA^^"
S ^ASUMC(ASUMS("E#","STA"),1,ASUK("DT","FYM#"),4,0)="^9002037.14PA^^"
S ^ASUMC(ASUMS("E#","STA"),1,ASUK("DT","FYM#"),5,0)="^9002037.15PA^^"
;All control sheet data blank for fiscal year month
S ASURX="W !?3,""Getting Month's Master Beginning Balances""" D ^ASUUPLOG
S ASUMS("E#","STA")=ASUL(2,"STA","E#")
D:$G(ASUN("TYP"))']"" RANGE^ASUURANG(2)
D LOAD^ASUCOHKP(.ASUN)
N X,Y,Z
F X=1:1:5,9 D
.I '$D(^TMP("ASUMC",$J,X)) D Q
..S ^ASUMC(ASUMS("E#","STA"),1,ASUK("DT","FYM#"),1,X,0)=X
.S Y=0 F S Y=$O(^TMP("ASUMC",$J,X,Y)) Q:Y']"" D
..S:$G(^ASUMC(ASUMS("E#","STA"),1,ASUK("DT","FYM#"),1,X,0))']"" ^ASUMC(ASUMS("E#","STA"),1,ASUK("DT","FYM#"),1,X,0)=X
..S Z=$G(Z)+$P(^TMP("ASUMC",$J,X,Y),U)
.S $P(^ASUMC(ASUMS("E#","STA"),1,ASUK("DT","FYM#"),1,X,0),U,2)=Z K Z
F S ASUN("KEY")=$O(^ASUH("B",ASUN("KEY"))) Q:ASUN("KEY")']"" Q:ASUN("KEY")>ASUN("EKY") D
.S ASUA=$O(^ASUH("B",ASUN("KEY"),""))
.N Y D READ^ASU0TRRD(.ASUA,"H") Q:Y<0 ;Read history record
.D RPT1,ACC,VOU,SCAN,DCAN,TRN
CLOSE ;
F X=1:1:5,9 D
.S Z=^ASUMC(ASUMS("E#","STA"),1,ASUK("DT","FYM#"),1,X,0)
.S Y=$P(Z,U,2) ;W !?10,"OPEN : ",?20,Y
.S Y=Y+$P(Z,U,3) ;W !,"+REC: ",$P(Z,U,3)," = ",?20,Y
.S Y=Y+$P(Z,U,4) ;W !,"+TFI: ",$P(Z,U,4)," = ",?20,Y
.S Y=Y+$P(Z,U,5) ;W !,"+PVR: ",$P(Z,U,5)," = ",?20,Y
.S Y=Y+$P(Z,U,6) ;W !,"-SKI: ",$P(Z,U,6)," = ",?20,Y
.S Y=Y+$P(Z,U,7) ;W !,"-TFO: ",$P(Z,U,7)," = ",?20,Y
.S Y=Y+$P(Z,U,8) ;W !,"+PVI: ",$P(Z,U,8)," = ",?20,Y
.S Y=Y+$P(Z,U,9) ;W !,"+-ADJ: ",$P(Z,U,9)," = ",?20,Y
.S $P(Z,U,10)=Y
.S ^ASUMC(ASUMS("E#","STA"),1,ASUK("DT","FYM#"),1,X,0)=Z
D RPT1YTD
S DIK="^ASUMC(" D IXALL^DIK
Q
RPT1 ;Collect data for report 1
CURMO ;Count transactions for report 1 - current month -subscript (2)
S X=$G(^XTMP("ASUR","R01",2,ASUL(11,"TRN","E#")))
I X']"" S X=ASUL(11,"TRN","E#")_"^^"_ASUL(11,"TRN","TYPE")
S $P(X,U,2)=$P(X,U,2)+1
S ^XTMP("ASUR","R01",2,ASUL(11,"TRN","E#"))=X
TODAY ;Get active items (transactions posted today) beginning balances
I $P(ASUN("KEY"),"-",2)=ASUK("DT","RUN") D
.;Count transactions for report 1 - processed today -subscript (1)
.S X=$G(^XTMP("ASUR","R01",1,ASUL(11,"TRN","E#")))
.I X']"" S X=ASUL(11,"TRN","E#")_"^^"_ASUL(11,"TRN","TYPE")
.S $P(X,U,2)=$P(X,U,2)+1
.S ^XTMP("ASUR","R01",1,ASUL(11,"TRN","E#"))=X
Q
RPT1YTD ; Collect year to date item counts for report 1 - subscript (3)
;M ^XTMP("ASUR","R01",3)=^XTMP("ASUR","R01",2) ;Start with current month
N W,X,Y,Z S Z=ASUK("DT","FYM#") F Z=Z:-1:1 D
.S Y=0 F S Y=$O(^ASUMC(ASUMS("E#","STA"),1,Z,5,Y)) Q:Y'?1N.N D
..S X=$G(^ASUMC(ASUMS("E#","STA"),1,Z,5,Y,0)),W=$G(^XTMP("ASUR","R01",3,Y)),$P(W,U)=Y,$P(W,U,2)=$P(W,U,2)+$P(X,U,2),^XTMP("ASUR","R01",3,Y)=W
Q
YEARCLR ;EP ;YEARLY CLEAR SUBSCRIPT 3
N W,X,Y,Z S Z=ASUK("DT","FYM#") F Z=Z:-1:1 D
.S Y=0 F S Y=$O(^ASUMC(ASUMS("E#","STA"),1,Z,5,Y)) Q:Y'?1N.N D
..S ^ASUMC(ASUMS("E#","STA"),1,Z,5,Y,0)=""
Q
ACC ;Accumulate value from transactions
S X=$G(^ASUMC(ASUMS("E#","STA"),1,ASUK("DT","FYM#"),1,ASUT(ASUT,"ACC"),0)),Z=ASUL(11,"TRN","TYPE")
S:X']"" X=ASUT(ASUT,"ACC")_U
S Y=$S(Z=2:3,Z=8:4,Z=3:6,Z=9:7,Z=6:9,Z=0:11,1:Z)
Q:Z=1
I Z=2,$E(ASUT("TRCD"),2)="0" S Y=5
I Z=3,$E(ASUT("TRCD"),2)="0" S Y=8
S $P(X,U,Y)=$P(X,U,Y)+(ASUT(ASUT,"VAL")*ASUL(11,"TRN","DRCR"))
S ^ASUMC(ASUMS("E#","STA"),1,ASUK("DT","FYM#"),1,ASUT(ASUT,"ACC"),0)=X
Q
VOU ;Accumulate Values by Vouchers
Q:$G(ASUT(ASUT,"VOU"))']"" Q:$G(ASUT(ASUT,"ACC"))']""
N X,Z
S ASUW("E#","VOU")=($P(ASUT(ASUT,"VOU"),"-"))_($P(ASUT(ASUT,"VOU"),"-",2))_($P(ASUT(ASUT,"VOU"),"-",3))
S Z=$G(^ASUMC(ASUMS("E#","STA"),1,ASUK("DT","FYM#"),2,ASUW("E#","VOU"),0))
I Z="" D
.S Z=ASUT(ASUT,"VOU")_U
.S ^ASUMC(ASUMS("E#","STA"),1,ASUK("DT","FYM#"),2,ASUW("E#","VOU"),0)=Z
.S ^ASUMC(ASUMS("E#","STA"),1,ASUK("DT","FYM#"),2,ASUW("E#","VOU"),1,0)="^9002037.121PA^^"
.S ^ASUMC(ASUMS("E#","STA"),1,ASUK("DT","FYM#"),2,"B",ASUT(ASUT,"VOU"),ASUW("E#","VOU"))=""
I $P(Z,U)'=ASUT(ASUT,"VOU") D
.S ASUW("E#","VOU")=$O(^ASUMC(ASUMS("E#","STA"),1,ASUK("DT","FYM#"),2,"B",ASUT(ASUT,"VOU"),""))
.I ASUW("E#","VOU")']"" D
..S ASUW("E#","VOU")=($P(ASUT(ASUT,"VOU"),"-"))_(($P(ASUT(ASUT,"VOU"),"-",2))_($P(ASUT(ASUT,"VOU"),"-",3)))
..S Z=$G(^ASUMC(ASUMS("E#","STA"),1,ASUK("DT","FYM#"),2,ASUW("E#","VOU"),0))
..I Z="" D
...S Z=ASUT(ASUT,"VOU")_U
...S ^ASUMC(ASUMS("E#","STA"),1,ASUK("DT","FYM#"),2,ASUW("E#","VOU"),0)=Z
...S ^ASUMC(ASUMS("E#","STA"),1,ASUK("DT","FYM#"),2,ASUW("E#","VOU"),1,0)="^9002037.121PA^^"
...S ^ASUMC(ASUMS("E#","STA"),1,ASUK("DT","FYM#"),2,"B",ASUT(ASUT,"VOU"),ASUW("E#","VOU"))=""
..I $P(Z,U)'=ASUT(ASUT,"VOU") D
...S Y=-1 Q
Q:Y<0
S X=$G(^ASUMC(ASUMS("E#","STA"),1,ASUK("DT","FYM#"),2,ASUW("E#","VOU"),1,ASUT(ASUT,"ACC"),0))
I X="" S X=ASUT(ASUT,"ACC")_U_0
S $P(X,U,2)=$P(X,U,2)+(ASUT(ASUT,"VAL")*ASUL(11,"TRN","DRCR"))
S ^ASUMC(ASUMS("E#","STA"),1,ASUK("DT","FYM#"),2,ASUW("E#","VOU"),1,ASUT(ASUT,"ACC"),0)=X
Q
SCAN ;Accumulate Values by Stock Issue Cans
Q:ASUL(11,"TRN","TYPE")'=3 Q:$G(ASUT(ASUT,"CAN"))']"" Q:$G(ASUT(ASUT,"ACC"))']""
N X,Z
S ASUW("E#","CAN")=+($P(ASUT(ASUT,"CAN"),ASUL(1,"AR","AP"),2))
I ASUW("E#","CAN")'?1N.N S ASUW("E#","CAN")=1
S Z=$G(^ASUMC(ASUMS("E#","STA"),1,ASUK("DT","FYM#"),3,ASUW("E#","CAN"),0))
I Z="" D
.S Z=ASUT(ASUT,"CAN")_U
.S ^ASUMC(ASUMS("E#","STA"),1,ASUK("DT","FYM#"),3,ASUW("E#","CAN"),0)=Z
.S ^ASUMC(ASUMS("E#","STA"),1,ASUK("DT","FYM#"),3,ASUW("E#","CAN"),1,0)="^9002037.131PA^^"
.S ^ASUMC(ASUMS("E#","STA"),1,ASUK("DT","FYM#"),3,"B",ASUT(ASUT,"CAN"),ASUW("E#","CAN"))=""
S Z=$G(^ASUMC(ASUMS("E#","STA"),1,ASUK("DT","FYM#"),3,ASUW("E#","CAN"),0))
I $P(Z,U)'=ASUT(ASUT,"CAN") D
.S ASUW("E#","CAN")=$O(^ASUMC(ASUMS("E#","STA"),1,ASUK("DT","FYM#"),3,"B",ASUT(ASUT,"CAN"),""))
.I ASUW("E#","CAN")']"" D
..S ASUW("E#","CAN")=+($P(ASUT(ASUT,"CAN"),"J",2)) I (ASUW("E#","CAN")'?1N.N)!(ASUW("E#","CAN")'>0) S Y=-1 Q
..S Z=$G(^ASUMC(ASUMS("E#","STA"),1,ASUK("DT","FYM#"),3,ASUW("E#","CAN"),0))
..I Z="" D
...S Z=ASUT(ASUT,"CAN")_U
...S ^ASUMC(ASUMS("E#","STA"),1,ASUK("DT","FYM#"),3,ASUW("E#","CAN"),0)=Z
...S ^ASUMC(ASUMS("E#","STA"),1,ASUK("DT","FYM#"),3,ASUW("E#","CAN"),1,0)="^9002037.131PA^^"
...S ^ASUMC(ASUMS("E#","STA"),1,ASUK("DT","FYM#"),3,"B",ASUT(ASUT,"CAN"),ASUW("E#","CAN"))=""
..I $P(Z,U)'=ASUT(ASUT,"CAN") D
...S Y=-1 Q
S X=$G(^ASUMC(ASUMS("E#","STA"),1,ASUK("DT","FYM#"),3,ASUW("E#","CAN"),1,ASUT(ASUT,"ACC"),0))
I X="" S X=ASUT(ASUT,"ACC")_U_0
Q:Y<0
S $P(X,U,2)=$P(X,U,2)+($G(ASUT(ASUT,"VAL"))*ASUL(11,"TRN","DRCR"))
S ^ASUMC(ASUMS("E#","STA"),1,ASUK("DT","FYM#"),3,ASUW("E#","CAN"),1,ASUT(ASUT,"ACC"),0)=X
Q
DCAN ;Accumulate Values by Direct issue Cans
Q:ASUL(11,"TRN","TYPE")'=9 Q:$G(ASUT(ASUT,"CAN"))']"" Q:$G(ASUT(ASUT,"ACC"))']""
N X,Z
S (X,ASUW("E#","CAN"))=$P(ASUT(ASUT,"CAN"),ASUL(1,"AR","AP"),2) S:X'?1N.N ASUW("E#","CAN")=+X
S Z=$G(^ASUMC(ASUMS("E#","STA"),1,ASUK("DT","FYM#"),4,ASUW("E#","CAN"),0))
I Z="" D
.S Z=ASUT(ASUT,"CAN")_U
.S ^ASUMC(ASUMS("E#","STA"),1,ASUK("DT","FYM#"),4,ASUW("E#","CAN"),0)=Z
.S ^ASUMC(ASUMS("E#","STA"),1,ASUK("DT","FYM#"),4,ASUW("E#","CAN"),1,0)="^9002037.141PA^^"
.S ^ASUMC(ASUMS("E#","STA"),1,ASUK("DT","FYM#"),4,"B",ASUT(ASUT,"CAN"),ASUW("E#","CAN"))=""
S Z=$G(^ASUMC(ASUMS("E#","STA"),1,ASUK("DT","FYM#"),4,ASUW("E#","CAN"),0))
I $P(Z,U)'=ASUT(ASUT,"CAN") D
.S ASUW("E#","CAN")=$O(^ASUMC(ASUMS("E#","STA"),1,ASUK("DT","FYM#"),4,"B",ASUT(ASUT,"CAN"),""))
.I ASUW("E#","CAN")']"" D
..S ASUW("E#","CAN")=+($P(ASUT(ASUT,"CAN"),"J",2)) I (ASUW("E#","CAN")'?1N.N)!(ASUW("E#","CAN")'>0) S Y=-1 Q
..S Z=$G(^ASUMC(ASUMS("E#","STA"),1,ASUK("DT","FYM#"),4,ASUW("E#","CAN"),0))
..I Z="" D
...S Z=ASUT(ASUT,"CAN")_U
...S ^ASUMC(ASUMS("E#","STA"),1,ASUK("DT","FYM#"),4,ASUW("E#","CAN"),0)=Z
...S ^ASUMC(ASUMS("E#","STA"),1,ASUK("DT","FYM#"),4,ASUW("E#","CAN"),1,0)="^9002037.141PA^^"
...S ^ASUMC(ASUMS("E#","STA"),1,ASUK("DT","FYM#"),4,"B",ASUT(ASUT,"CAN"),ASUW("E#","CAN"))=""
..I $P(Z,U)'=ASUT(ASUT,"CAN") D
...S Y=-1 Q
S X=$G(^ASUMC(ASUMS("E#","STA"),1,ASUK("DT","FYM#"),4,ASUW("E#","CAN"),1,ASUT(ASUT,"ACC"),0))
I X="" S X=ASUT(ASUT,"ACC")_U_0
Q:Y<0
S $P(X,U,2)=$P(X,U,2)+($G(ASUT(ASUT,"VAL"))*ASUL(11,"TRN","DRCR"))
S ^ASUMC(ASUMS("E#","STA"),1,ASUK("DT","FYM#"),4,ASUW("E#","CAN"),1,ASUT(ASUT,"ACC"),0)=X
Q
TRN ;Accumulate Values by Transaction code
;Update Control sheet master for current month Item counts/Balances
N X S X=$G(^ASUMC(ASUMS("E#","STA"),1,ASUK("DT","FYM#"),5,ASUL(11,"TRN","E#"),0))
I X']"" D
.S X=ASUL(11,"TRN","E#")_"^^"_ASUL(11,"TRN","TYPE")
S $P(X,U,2)=$P(X,U,2)+1
S ^ASUMC(ASUMS("E#","STA"),1,ASUK("DT","FYM#"),5,ASUL(11,"TRN","E#"),0)=X
Q
ASUMCUPD ; IHS/ITSC/LMH -CONTROL SHEET UPDATE ;
+1 ;;4.2T2;Supply Accounting Mgmt. System;;JUN 30, 2000
+2 ;This routine initializes Control Sheet Master for Fiscal Year Month
+3 IF $GET(ASUMC(ASUMS("E#","STA"),0))']""
SET ^ASUMC(ASUMS("E#","STA"),0)=ASUMS("E#","STA")
+4 KILL ^ASUMC(ASUMS("E#","STA"),1,ASUK("DT","FYM#"))
+5 SET ^ASUMC(ASUMS("E#","STA"),1,ASUK("DT","FYM#"),0)=ASUK("DT","FYM#")
+6 IF $GET(ASUMC(ASUMS("E#","STA"),1,0))']""
SET ^ASUMC(ASUMS("E#","STA"),1,0)="^9002037.01^^"
+7 SET ^ASUMC(ASUMS("E#","STA"),1,ASUK("DT","FYM#"),1,0)="^9002037.11PA^^"
+8 SET ^ASUMC(ASUMS("E#","STA"),1,ASUK("DT","FYM#"),2,0)="^9002037.12PA^^"
+9 SET ^ASUMC(ASUMS("E#","STA"),1,ASUK("DT","FYM#"),3,0)="^9002037.13PA^^"
+10 SET ^ASUMC(ASUMS("E#","STA"),1,ASUK("DT","FYM#"),4,0)="^9002037.14PA^^"
+11 SET ^ASUMC(ASUMS("E#","STA"),1,ASUK("DT","FYM#"),5,0)="^9002037.15PA^^"
+12 ;All control sheet data blank for fiscal year month
+13 SET ASURX="W !?3,""Getting Month's Master Beginning Balances"""
DO ^ASUUPLOG
+14 SET ASUMS("E#","STA")=ASUL(2,"STA","E#")
+15 IF $GET(ASUN("TYP"))']""
DO RANGE^ASUURANG(2)
+16 DO LOAD^ASUCOHKP(.ASUN)
+17 NEW X,Y,Z
+18 FOR X=1:1:5,9
Begin DoDot:1
+19 IF '$DATA(^TMP("ASUMC",$JOB,X))
Begin DoDot:2
+20 SET ^ASUMC(ASUMS("E#","STA"),1,ASUK("DT","FYM#"),1,X,0)=X
End DoDot:2
QUIT
+21 SET Y=0
FOR
SET Y=$ORDER(^TMP("ASUMC",$JOB,X,Y))
IF Y']""
QUIT
Begin DoDot:2
+22 IF $GET(^ASUMC(ASUMS("E#","STA"),1,ASUK("DT","FYM#"),1,X,0))']""
SET ^ASUMC(ASUMS("E#","STA"),1,ASUK("DT","FYM#"),1,X,0)=X
+23 SET Z=$GET(Z)+$PIECE(^TMP("ASUMC",$JOB,X,Y),U)
End DoDot:2
+24 SET $PIECE(^ASUMC(ASUMS("E#","STA"),1,ASUK("DT","FYM#"),1,X,0),U,2)=Z
KILL Z
End DoDot:1
+25 FOR
SET ASUN("KEY")=$ORDER(^ASUH("B",ASUN("KEY")))
IF ASUN("KEY")']""
QUIT
IF ASUN("KEY")>ASUN("EKY")
QUIT
Begin DoDot:1
+26 SET ASUA=$ORDER(^ASUH("B",ASUN("KEY"),""))
+27 ;Read history record
NEW Y
DO READ^ASU0TRRD(.ASUA,"H")
IF Y<0
QUIT
+28 DO RPT1
DO ACC
DO VOU
DO SCAN
DO DCAN
DO TRN
End DoDot:1
CLOSE ;
+1 FOR X=1:1:5,9
Begin DoDot:1
+2 SET Z=^ASUMC(ASUMS("E#","STA"),1,ASUK("DT","FYM#"),1,X,0)
+3 ;W !?10,"OPEN : ",?20,Y
SET Y=$PIECE(Z,U,2)
+4 ;W !,"+REC: ",$P(Z,U,3)," = ",?20,Y
SET Y=Y+$PIECE(Z,U,3)
+5 ;W !,"+TFI: ",$P(Z,U,4)," = ",?20,Y
SET Y=Y+$PIECE(Z,U,4)
+6 ;W !,"+PVR: ",$P(Z,U,5)," = ",?20,Y
SET Y=Y+$PIECE(Z,U,5)
+7 ;W !,"-SKI: ",$P(Z,U,6)," = ",?20,Y
SET Y=Y+$PIECE(Z,U,6)
+8 ;W !,"-TFO: ",$P(Z,U,7)," = ",?20,Y
SET Y=Y+$PIECE(Z,U,7)
+9 ;W !,"+PVI: ",$P(Z,U,8)," = ",?20,Y
SET Y=Y+$PIECE(Z,U,8)
+10 ;W !,"+-ADJ: ",$P(Z,U,9)," = ",?20,Y
SET Y=Y+$PIECE(Z,U,9)
+11 SET $PIECE(Z,U,10)=Y
+12 SET ^ASUMC(ASUMS("E#","STA"),1,ASUK("DT","FYM#"),1,X,0)=Z
End DoDot:1
+13 DO RPT1YTD
+14 SET DIK="^ASUMC("
DO IXALL^DIK
+15 QUIT
RPT1 ;Collect data for report 1
CURMO ;Count transactions for report 1 - current month -subscript (2)
+1 SET X=$GET(^XTMP("ASUR","R01",2,ASUL(11,"TRN","E#")))
+2 IF X']""
SET X=ASUL(11,"TRN","E#")_"^^"_ASUL(11,"TRN","TYPE")
+3 SET $PIECE(X,U,2)=$PIECE(X,U,2)+1
+4 SET ^XTMP("ASUR","R01",2,ASUL(11,"TRN","E#"))=X
TODAY ;Get active items (transactions posted today) beginning balances
+1 IF $PIECE(ASUN("KEY"),"-",2)=ASUK("DT","RUN")
Begin DoDot:1
+2 ;Count transactions for report 1 - processed today -subscript (1)
+3 SET X=$GET(^XTMP("ASUR","R01",1,ASUL(11,"TRN","E#")))
+4 IF X']""
SET X=ASUL(11,"TRN","E#")_"^^"_ASUL(11,"TRN","TYPE")
+5 SET $PIECE(X,U,2)=$PIECE(X,U,2)+1
+6 SET ^XTMP("ASUR","R01",1,ASUL(11,"TRN","E#"))=X
End DoDot:1
+7 QUIT
RPT1YTD ; Collect year to date item counts for report 1 - subscript (3)
+1 ;M ^XTMP("ASUR","R01",3)=^XTMP("ASUR","R01",2) ;Start with current month
+2 NEW W,X,Y,Z
SET Z=ASUK("DT","FYM#")
FOR Z=Z:-1:1
Begin DoDot:1
+3 SET Y=0
FOR
SET Y=$ORDER(^ASUMC(ASUMS("E#","STA"),1,Z,5,Y))
IF Y'?1N.N
QUIT
Begin DoDot:2
+4 SET X=$GET(^ASUMC(ASUMS("E#","STA"),1,Z,5,Y,0))
SET W=$GET(^XTMP("ASUR","R01",3,Y))
SET $PIECE(W,U)=Y
SET $PIECE(W,U,2)=$PIECE(W,U,2)+$PIECE(X,U,2)
SET ^XTMP("ASUR","R01",3,Y)=W
End DoDot:2
End DoDot:1
+5 QUIT
YEARCLR ;EP ;YEARLY CLEAR SUBSCRIPT 3
+1 NEW W,X,Y,Z
SET Z=ASUK("DT","FYM#")
FOR Z=Z:-1:1
Begin DoDot:1
+2 SET Y=0
FOR
SET Y=$ORDER(^ASUMC(ASUMS("E#","STA"),1,Z,5,Y))
IF Y'?1N.N
QUIT
Begin DoDot:2
+3 SET ^ASUMC(ASUMS("E#","STA"),1,Z,5,Y,0)=""
End DoDot:2
End DoDot:1
+4 QUIT
ACC ;Accumulate value from transactions
+1 SET X=$GET(^ASUMC(ASUMS("E#","STA"),1,ASUK("DT","FYM#"),1,ASUT(ASUT,"ACC"),0))
SET Z=ASUL(11,"TRN","TYPE")
+2 IF X']""
SET X=ASUT(ASUT,"ACC")_U
+3 SET Y=$SELECT(Z=2:3,Z=8:4,Z=3:6,Z=9:7,Z=6:9,Z=0:11,1:Z)
+4 IF Z=1
QUIT
+5 IF Z=2
IF $EXTRACT(ASUT("TRCD"),2)="0"
SET Y=5
+6 IF Z=3
IF $EXTRACT(ASUT("TRCD"),2)="0"
SET Y=8
+7 SET $PIECE(X,U,Y)=$PIECE(X,U,Y)+(ASUT(ASUT,"VAL")*ASUL(11,"TRN","DRCR"))
+8 SET ^ASUMC(ASUMS("E#","STA"),1,ASUK("DT","FYM#"),1,ASUT(ASUT,"ACC"),0)=X
+9 QUIT
VOU ;Accumulate Values by Vouchers
+1 IF $GET(ASUT(ASUT,"VOU"))']""
QUIT
IF $GET(ASUT(ASUT,"ACC"))']""
QUIT
+2 NEW X,Z
+3 SET ASUW("E#","VOU")=($PIECE(ASUT(ASUT,"VOU"),"-"))_($PIECE(ASUT(ASUT,"VOU"),"-",2))_($PIECE(ASUT(ASUT,"VOU"),"-",3))
+4 SET Z=$GET(^ASUMC(ASUMS("E#","STA"),1,ASUK("DT","FYM#"),2,ASUW("E#","VOU"),0))
+5 IF Z=""
Begin DoDot:1
+6 SET Z=ASUT(ASUT,"VOU")_U
+7 SET ^ASUMC(ASUMS("E#","STA"),1,ASUK("DT","FYM#"),2,ASUW("E#","VOU"),0)=Z
+8 SET ^ASUMC(ASUMS("E#","STA"),1,ASUK("DT","FYM#"),2,ASUW("E#","VOU"),1,0)="^9002037.121PA^^"
+9 SET ^ASUMC(ASUMS("E#","STA"),1,ASUK("DT","FYM#"),2,"B",ASUT(ASUT,"VOU"),ASUW("E#","VOU"))=""
End DoDot:1
+10 IF $PIECE(Z,U)'=ASUT(ASUT,"VOU")
Begin DoDot:1
+11 SET ASUW("E#","VOU")=$ORDER(^ASUMC(ASUMS("E#","STA"),1,ASUK("DT","FYM#"),2,"B",ASUT(ASUT,"VOU"),""))
+12 IF ASUW("E#","VOU")']""
Begin DoDot:2
+13 SET ASUW("E#","VOU")=($PIECE(ASUT(ASUT,"VOU"),"-"))_(($PIECE(ASUT(ASUT,"VOU"),"-",2))_($PIECE(ASUT(ASUT,"VOU"),"-",3)))
+14 SET Z=$GET(^ASUMC(ASUMS("E#","STA"),1,ASUK("DT","FYM#"),2,ASUW("E#","VOU"),0))
+15 IF Z=""
Begin DoDot:3
+16 SET Z=ASUT(ASUT,"VOU")_U
+17 SET ^ASUMC(ASUMS("E#","STA"),1,ASUK("DT","FYM#"),2,ASUW("E#","VOU"),0)=Z
+18 SET ^ASUMC(ASUMS("E#","STA"),1,ASUK("DT","FYM#"),2,ASUW("E#","VOU"),1,0)="^9002037.121PA^^"
+19 SET ^ASUMC(ASUMS("E#","STA"),1,ASUK("DT","FYM#"),2,"B",ASUT(ASUT,"VOU"),ASUW("E#","VOU"))=""
End DoDot:3
+20 IF $PIECE(Z,U)'=ASUT(ASUT,"VOU")
Begin DoDot:3
+21 SET Y=-1
QUIT
End DoDot:3
End DoDot:2
End DoDot:1
+22 IF Y<0
QUIT
+23 SET X=$GET(^ASUMC(ASUMS("E#","STA"),1,ASUK("DT","FYM#"),2,ASUW("E#","VOU"),1,ASUT(ASUT,"ACC"),0))
+24 IF X=""
SET X=ASUT(ASUT,"ACC")_U_0
+25 SET $PIECE(X,U,2)=$PIECE(X,U,2)+(ASUT(ASUT,"VAL")*ASUL(11,"TRN","DRCR"))
+26 SET ^ASUMC(ASUMS("E#","STA"),1,ASUK("DT","FYM#"),2,ASUW("E#","VOU"),1,ASUT(ASUT,"ACC"),0)=X
+27 QUIT
SCAN ;Accumulate Values by Stock Issue Cans
+1 IF ASUL(11,"TRN","TYPE")'=3
QUIT
IF $GET(ASUT(ASUT,"CAN"))']""
QUIT
IF $GET(ASUT(ASUT,"ACC"))']""
QUIT
+2 NEW X,Z
+3 SET ASUW("E#","CAN")=+($PIECE(ASUT(ASUT,"CAN"),ASUL(1,"AR","AP"),2))
+4 IF ASUW("E#","CAN")'?1N.N
SET ASUW("E#","CAN")=1
+5 SET Z=$GET(^ASUMC(ASUMS("E#","STA"),1,ASUK("DT","FYM#"),3,ASUW("E#","CAN"),0))
+6 IF Z=""
Begin DoDot:1
+7 SET Z=ASUT(ASUT,"CAN")_U
+8 SET ^ASUMC(ASUMS("E#","STA"),1,ASUK("DT","FYM#"),3,ASUW("E#","CAN"),0)=Z
+9 SET ^ASUMC(ASUMS("E#","STA"),1,ASUK("DT","FYM#"),3,ASUW("E#","CAN"),1,0)="^9002037.131PA^^"
+10 SET ^ASUMC(ASUMS("E#","STA"),1,ASUK("DT","FYM#"),3,"B",ASUT(ASUT,"CAN"),ASUW("E#","CAN"))=""
End DoDot:1
+11 SET Z=$GET(^ASUMC(ASUMS("E#","STA"),1,ASUK("DT","FYM#"),3,ASUW("E#","CAN"),0))
+12 IF $PIECE(Z,U)'=ASUT(ASUT,"CAN")
Begin DoDot:1
+13 SET ASUW("E#","CAN")=$ORDER(^ASUMC(ASUMS("E#","STA"),1,ASUK("DT","FYM#"),3,"B",ASUT(ASUT,"CAN"),""))
+14 IF ASUW("E#","CAN")']""
Begin DoDot:2
+15 SET ASUW("E#","CAN")=+($PIECE(ASUT(ASUT,"CAN"),"J",2))
IF (ASUW("E#","CAN")'?1N.N)!(ASUW("E#","CAN")'>0)
SET Y=-1
QUIT
+16 SET Z=$GET(^ASUMC(ASUMS("E#","STA"),1,ASUK("DT","FYM#"),3,ASUW("E#","CAN"),0))
+17 IF Z=""
Begin DoDot:3
+18 SET Z=ASUT(ASUT,"CAN")_U
+19 SET ^ASUMC(ASUMS("E#","STA"),1,ASUK("DT","FYM#"),3,ASUW("E#","CAN"),0)=Z
+20 SET ^ASUMC(ASUMS("E#","STA"),1,ASUK("DT","FYM#"),3,ASUW("E#","CAN"),1,0)="^9002037.131PA^^"
+21 SET ^ASUMC(ASUMS("E#","STA"),1,ASUK("DT","FYM#"),3,"B",ASUT(ASUT,"CAN"),ASUW("E#","CAN"))=""
End DoDot:3
+22 IF $PIECE(Z,U)'=ASUT(ASUT,"CAN")
Begin DoDot:3
+23 SET Y=-1
QUIT
End DoDot:3
End DoDot:2
End DoDot:1
+24 SET X=$GET(^ASUMC(ASUMS("E#","STA"),1,ASUK("DT","FYM#"),3,ASUW("E#","CAN"),1,ASUT(ASUT,"ACC"),0))
+25 IF X=""
SET X=ASUT(ASUT,"ACC")_U_0
+26 IF Y<0
QUIT
+27 SET $PIECE(X,U,2)=$PIECE(X,U,2)+($GET(ASUT(ASUT,"VAL"))*ASUL(11,"TRN","DRCR"))
+28 SET ^ASUMC(ASUMS("E#","STA"),1,ASUK("DT","FYM#"),3,ASUW("E#","CAN"),1,ASUT(ASUT,"ACC"),0)=X
+29 QUIT
DCAN ;Accumulate Values by Direct issue Cans
+1 IF ASUL(11,"TRN","TYPE")'=9
QUIT
IF $GET(ASUT(ASUT,"CAN"))']""
QUIT
IF $GET(ASUT(ASUT,"ACC"))']""
QUIT
+2 NEW X,Z
+3 SET (X,ASUW("E#","CAN"))=$PIECE(ASUT(ASUT,"CAN"),ASUL(1,"AR","AP"),2)
IF X'?1N.N
SET ASUW("E#","CAN")=+X
+4 SET Z=$GET(^ASUMC(ASUMS("E#","STA"),1,ASUK("DT","FYM#"),4,ASUW("E#","CAN"),0))
+5 IF Z=""
Begin DoDot:1
+6 SET Z=ASUT(ASUT,"CAN")_U
+7 SET ^ASUMC(ASUMS("E#","STA"),1,ASUK("DT","FYM#"),4,ASUW("E#","CAN"),0)=Z
+8 SET ^ASUMC(ASUMS("E#","STA"),1,ASUK("DT","FYM#"),4,ASUW("E#","CAN"),1,0)="^9002037.141PA^^"
+9 SET ^ASUMC(ASUMS("E#","STA"),1,ASUK("DT","FYM#"),4,"B",ASUT(ASUT,"CAN"),ASUW("E#","CAN"))=""
End DoDot:1
+10 SET Z=$GET(^ASUMC(ASUMS("E#","STA"),1,ASUK("DT","FYM#"),4,ASUW("E#","CAN"),0))
+11 IF $PIECE(Z,U)'=ASUT(ASUT,"CAN")
Begin DoDot:1
+12 SET ASUW("E#","CAN")=$ORDER(^ASUMC(ASUMS("E#","STA"),1,ASUK("DT","FYM#"),4,"B",ASUT(ASUT,"CAN"),""))
+13 IF ASUW("E#","CAN")']""
Begin DoDot:2
+14 SET ASUW("E#","CAN")=+($PIECE(ASUT(ASUT,"CAN"),"J",2))
IF (ASUW("E#","CAN")'?1N.N)!(ASUW("E#","CAN")'>0)
SET Y=-1
QUIT
+15 SET Z=$GET(^ASUMC(ASUMS("E#","STA"),1,ASUK("DT","FYM#"),4,ASUW("E#","CAN"),0))
+16 IF Z=""
Begin DoDot:3
+17 SET Z=ASUT(ASUT,"CAN")_U
+18 SET ^ASUMC(ASUMS("E#","STA"),1,ASUK("DT","FYM#"),4,ASUW("E#","CAN"),0)=Z
+19 SET ^ASUMC(ASUMS("E#","STA"),1,ASUK("DT","FYM#"),4,ASUW("E#","CAN"),1,0)="^9002037.141PA^^"
+20 SET ^ASUMC(ASUMS("E#","STA"),1,ASUK("DT","FYM#"),4,"B",ASUT(ASUT,"CAN"),ASUW("E#","CAN"))=""
End DoDot:3
+21 IF $PIECE(Z,U)'=ASUT(ASUT,"CAN")
Begin DoDot:3
+22 SET Y=-1
QUIT
End DoDot:3
End DoDot:2
End DoDot:1
+23 SET X=$GET(^ASUMC(ASUMS("E#","STA"),1,ASUK("DT","FYM#"),4,ASUW("E#","CAN"),1,ASUT(ASUT,"ACC"),0))
+24 IF X=""
SET X=ASUT(ASUT,"ACC")_U_0
+25 IF Y<0
QUIT
+26 SET $PIECE(X,U,2)=$PIECE(X,U,2)+($GET(ASUT(ASUT,"VAL"))*ASUL(11,"TRN","DRCR"))
+27 SET ^ASUMC(ASUMS("E#","STA"),1,ASUK("DT","FYM#"),4,ASUW("E#","CAN"),1,ASUT(ASUT,"ACC"),0)=X
+28 QUIT
TRN ;Accumulate Values by Transaction code
+1 ;Update Control sheet master for current month Item counts/Balances
+2 NEW X
SET X=$GET(^ASUMC(ASUMS("E#","STA"),1,ASUK("DT","FYM#"),5,ASUL(11,"TRN","E#"),0))
+3 IF X']""
Begin DoDot:1
+4 SET X=ASUL(11,"TRN","E#")_"^^"_ASUL(11,"TRN","TYPE")
End DoDot:1
+5 SET $PIECE(X,U,2)=$PIECE(X,U,2)+1
+6 SET ^ASUMC(ASUMS("E#","STA"),1,ASUK("DT","FYM#"),5,ASUL(11,"TRN","E#"),0)=X
+7 QUIT
