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

ASUMSTWR.m

Go to the documentation of this file. 
  1. ASUMSTWR ; IHS/ITSC/LMH -UPDATE STATION MASTER FROM VARIABLES ;  
  1.  ;;4.2T2;Supply Accounting Mgmt. System;;JUN 30, 2000
  1. M ;EP SET ALL FIELDS -STA MASTER
  1.  S:'$D(ASUS("ADD")) ASUS("ADD")=1
  1.  D MI,MIC,MEXP
  1.  Q:'$D(ASUS("ADD"))
  1.  Q:ASUS("ADD")'>0
  1.  I ASUS("ADD")=1 D
  1.  .S:$G(^ASUMS(ASUMS("E#","STA"),1,0))="" ^ASUMS(ASUMS("E#","STA"),1,0)="^9002031.02PA"
  1.  .S $P(^ASUMS(ASUMS("E#","STA"),1,0),U,3)=$P(^ASUMS(ASUMS("E#","STA"),1,0),U,3)+1
  1.  .S $P(^ASUMS(ASUMS("E#","STA"),1,0),U,4)=ASUMS("E#","IDX")
  1.  .S ^ASUMS(ASUMS("E#","STA"),1,ASUMS("E#","IDX"),1,0)="^9002031.232A^12^12"
  1.  D X
  1.  K DIKGP,DIKND,DIKNX,DIKST,DIKZ1,DIKNM,DIG,DIH,DIV,DIW,%,DH,DIWF Q
  1. X ;
  1.  S DIK="^ASUMS("_ASUMS("E#","STA")_",1,",DA=ASUMS("E#","IDX"),DA(1)=ASUMS("E#","STA")
  1.  D IX1^DIK K DIK
  1.  Q
  1. MIX ;EP ;SET ONLY MAIN FIELDS THEN RE-CROSSREFERENCE
  1.  D MI,X Q
  1. S ;EP SET FIELDS -STA MASTER
  1.  I $G(ASUMS("E#","STA"))="",$G(ASUL(2,"STA","E#"))]"" S ASUMS("E#","STA")=ASUL(2,"STA","E#")
  1.  Q:'$D(ASUMS("E#","STA"))
  1.  S $P(ASUMS(0),U)=ASUMS("STA")
  1.  S $P(ASUMS(0),U,2)=ASUMS("AR")
  1.  S ^ASUMS(ASUMS("E#","STA"),0)=ASUMS(0)
  1.  Q
  1. MI ;EP SET STATION MASTER DATA VARIABLES
  1.  I $G(ASUMS("E#","IDX"))="",$G(ASUMX("E#","IDX"))]"" S ASUMS("E#","IDX")=ASUMX("E#","IDX")
  1.  Q:'$D(ASUMS("E#","IDX"))
  1.  S:'$D(ASUS("ADD")) ASUS("ADD")=0
  1.  S $P(ASUMS(0),U)=ASUMS("E#","IDX")
  1.  S $P(ASUMS(0),U,2)=ASUMS("ESTB")
  1.  S $P(ASUMS(0),U,3)=ASUMS("ORD#")
  1.  S $P(ASUMS(0),U,4)=ASUMS("SRC")
  1.  S $P(ASUMS(0),U,5)=ASUMS("LTM")
  1.  S $P(ASUMS(0),U,6)=ASUMS("RPQ-O")
  1.  S $P(ASUMS(0),U,7)=ASUMS("PMIQ")
  1.  S $P(ASUMS(0),U,8)=ASUMS("RPQ")
  1.  S $P(ASUMS(0),U,9)=ASUMS("EOQ","TB")
  1.  S $P(ASUMS(0),U,10)=ASUMS("EOQ","MM")
  1.  S $P(ASUMS(0),U,11)=ASUMS("EOQ","QM")
  1.  S $P(ASUMS(0),U,12)=ASUMS("EOQ","AM")
  1.  F ASUU(19)=1:1:4 D
  1.  .Q:$E(ASUMS("EOQ","AM"),ASUU(19),ASUU(19))='0
  1.  .S ASUMS("EOQ","AM")=$E(ASUMS("EOQ","AM"),1,ASUU(19)-1)_" "_$E(ASUMS("EOQ","AM"),ASUU(19)+1,$L(ASUMS("EOQ","AM")))
  1.  S $P(ASUMS(0),U,13)=ASUMS("LSTISS")
  1.  S $P(ASUMS(0),U,14)=ASUMS("VENAM")
  1.  S $P(ASUMS(0),U,15)=+ASUMS("LPP")
  1.  S $P(ASUMS(0),U,16)=ASUMS("VAL","O/H")
  1.  S $P(ASUMS(0),U,17)=ASUMS("QTY","O/H")
  1.  I ASUS("ADD")=1 G ASUN2
  1.  S $P(ASUMS(0),U,18)=ASUMS("D/I","QTY",1)
  1.  S $P(ASUMS(0),U,19)=ASUMS("D/I","VAL",1)
  1.  S $P(ASUMS(0),U,20)=ASUMS("D/I","PO#",1)
  1.  S $P(ASUMS(0),U,21)=ASUMS("D/I","DT",1)
  1.  S $P(ASUMS(0),U,22)=ASUMS("D/I","SSA",1)
  1.  S $P(ASUMS(0),U,23)=ASUMS("D/I","QTY",2)
  1.  S $P(ASUMS(0),U,24)=ASUMS("D/I","VAL",2)
  1.  S $P(ASUMS(0),U,25)=ASUMS("D/I","PO#",2)
  1.  S $P(ASUMS(0),U,26)=ASUMS("D/I","DT",2)
  1.  S $P(ASUMS(0),U,27)=ASUMS("D/I","SSA",2)
  1.  S $P(ASUMS(0),U,28)=ASUMS("D/I","QTY",3)
  1.  S $P(ASUMS(0),U,29)=ASUMS("D/I","VAL",3)
  1.  S $P(ASUMS(0),U,30)=ASUMS("D/I","PO#",3)
  1.  S $P(ASUMS(0),U,31)=ASUMS("D/I","DT",3)
  1.  S $P(ASUMS(0),U,32)=ASUMS("D/I","SSA",3)
  1. ASUN2 ;
  1.  S $P(ASUMS(2),U)=ASUMS("SLC")
  1.  S $P(ASUMS(2),U,2)=ASUMS("D/O","QTY")
  1.  S $P(ASUMS(2),U,3)=ASUMS("VENUI")
  1.  S $P(ASUMS(2),U,4)=ASUMS("SFSKM")
  1.  S $P(ASUMS(2),U,5)=ASUMS("EOQ","TP")
  1.  S $P(ASUMS(2),U,6)=ASUMS("SPQ")
  1.  S $P(ASUMS(2),U,7)=ASUMS("VALBEG")
  1.  S $P(ASUMS(2),U,8)=ASUMS("QTY-BEG")
  1.  S $P(ASUMS(2),U,9)=ASUMS("D/I","DTR72",1)
  1.  S $P(ASUMS(2),U,10)=ASUMS("D/I","DTR72",2)
  1.  S $P(ASUMS(2),U,11)=ASUMS("D/I","DTR72",3)
  1. ASUN3 ;
  1.  S $P(ASUMS(3),U)=$G(ASUMS("R73","REM"))
  1.  S $P(ASUMS(3),U,2)=$G(ASUMS("R73","PER"))
  1.  S $P(ASUMS(3),U,3)=$G(ASUMS("R73","DT"))
  1.  S $P(ASUMS(3),U,4)=$G(ASUMS("R13","TIMES"))
  1.  S ^ASUMS(ASUMS("E#","STA"),1,ASUMS("E#","IDX"),0)=ASUMS(0)
  1.  S ^ASUMS(ASUMS("E#","STA"),1,ASUMS("E#","IDX"),2)=ASUMS(2)
  1.  S ^ASUMS(ASUMS("E#","STA"),1,ASUMS("E#","IDX"),3)=ASUMS(3)
  1.  I ASUS("ADD")=0 K ASUS("ADD")
  1.  Q
  1. MIC ;EP SET STATION DEMAND DATA,(SUBSCRIPTED BY MONTH)
  1.  I $D(ASUMS("E#","STA"))&($D(ASUMS("E#","IDX"))) D
  1.  .S:'$D(ASUS("ADD")) ASUS("ADD")=0
  1.  .F ASUV("MO")=1:1:12 D MMC
  1.  .K ASUV("MO"),ASUMS("DMD",0)
  1.  Q
  1. MMC ;GET ONE MONTH
  1.  S ASUMS("DMD",0)=""
  1.  S $P(ASUMS("DMD",0),U)=ASUV("MO")
  1.  S $P(ASUMS("DMD",0),U,2)=ASUMS("DMD","CALL",ASUV("MO"))
  1.  S $P(ASUMS("DMD",0),U,3)=ASUMS("DMD","QTY",ASUV("MO"))
  1.  S ^ASUMS(ASUMS("E#","STA"),1,ASUMS("E#","IDX"),1,ASUV("MO"),0)=ASUMS("DMD",0)
  1.  S:ASUS("ADD") ^ASUMS(ASUMS("E#","STA"),1,ASUMS("E#","IDX"),1,"B",ASUV("MO"),ASUV("MO"))=""
  1.  Q
  1. MEXP ;
  1.  N X
  1.  K ^ASUMS(ASUMS("E#","STA"),1,ASUMS("E#","IDX"),4)
  1.  S ^ASUMS(ASUMS("E#","STA"),1,ASUMS("E#","IDX"),4,0)="^9002031.244DA"
  1.  I ASUMS("DXP")=0 S $P(^ASUMS(ASUMS("E#","STA"),1,ASUMS("E#","IDX"),4,0),U,3)=0 Q
  1.  S Y=0
  1.  F  S Y=$O(ASUMS("DXP",Y)) Q:Y=""  S ^ASUMS(ASUMS("E#","STA"),1,ASUMS("E#","IDX"),4,$P(ASUMS("DXP",Y),U,2),0)=Y_U_$P(ASUMS("DXP",Y),U)
  1.  Q
  1. D ;EP; DELETE STATION MASTER
  1.  ;Station Index record may be cleared of information
  1.  S (ASUMS("E#","DEL"),DA)=ASUL(1,"AR","AP")_999999
  1.  S $P(^ASUMS(ASUMS("E#","STA"),1,ASUMS("E#","IDX"),0),U)=ASUMS("E#","DEL")
  1.  S $P(^ASUMS(ASUMS("E#","STA"),1,ASUMS("E#","IDX"),0),U,2)=$S($D(ASUT(ASUT,"DTEST")):ASUT(ASUT,"DTEST"),1:$E(ASUK("DT","YRMO")))
  1.  S DIK="^ASUMS("_ASUL(2,"STA","E#")_",1,"        ;ASUL(2  is a constant
  1.  S DA=ASUMS("E#","IDX"),DA(1)=ASUL(2,"STA","E#")
  1.  D IX^DIK K DIK,DA
  1.  Q