Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: ASUMCUPD

ASUMCUPD.m

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