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

ASUMSTRD.m

Go to the documentation of this file. 
  1. ASUMSTRD ; IHS/ITSC/LMH -SET FIELD VARS STATION MASTER ;  
  1.  ;;4.2T2;Supply Accounting Mgmt. System;;JUN 30, 2000
  1.  ;;This routine is a utility routine which provides an entry point to
  1.  ;;read (retreve) data from the SAMS Station Master file.
  1.  ;;(in global ^ASUMS & VA Fileman file ASUMST STATION)
  1. M ;EP;SET ALL
  1.  D S,MI,MIC,MEXP Q
  1. S ;EP SET FIELDS
  1.  I $G(ASUMS("E#","STA"))="" S ASUMS("E#","STA")=$G(ASUL(2,"STA","E#")) Q:ASUMS("E#","STA")']""
  1.  S ASUMS(0)=$G(^ASUMS(ASUMS("E#","STA"),0)) I ASUMS(0)="" S Y=-1 Q
  1.  S ASUMS("STA")=$P(ASUMS(0),U)
  1.  S ASUMS("AR")=$P(ASUMS(0),U,2)
  1.  Q
  1. SK ;EP KILL DFN & VARS
  1.  K ASUMS("E#","STA")
  1. SKF ;EP KILL DATA VARS
  1.  K ASUMS("STA"),ASUMS("AR"),ASUMS(0) Q
  1. MI ;EP SET DATA VARS
  1.  I $G(ASUMS("E#","IDX"))="" S ASUMS("E#","IDX")=$G(ASUMX("E#","IDX"))
  1.  I ASUMS("E#","IDX")="" S (ASUMS(0),ASUMS(2),ASUMS(3))="" D ASUSRIDX Q
  1.  S ASUMS(0)=$G(^ASUMS(ASUMS("E#","STA"),1,ASUMS("E#","IDX"),0))
  1.  I ($P(ASUMS(0),U)[999999)!($P($G(^ASUMX(ASUMS("E#","IDX"),0)),U,1)[999999) S ASUF("DLIDX")=1
  1.  E  S ASUF("DLIDX")=0 S:ASUMS(0)="" ASUMS(0)=ASUMS("E#","IDX")
  1.  S ASUMS("ESTB")=$P(ASUMS(0),U,2)
  1.  S ASUMS(2)=$G(^ASUMS(ASUMS("E#","STA"),1,ASUMS("E#","IDX"),2))
  1.  S ASUMS(3)=$G(^ASUMS(ASUMS("E#","STA"),1,ASUMS("E#","IDX"),3))
  1.  D ASUSRIDX
  1.  Q
  1. MIK ;EP KILL STATION DFN & DATA VARIABLES
  1.  K ASUMS("E#","IDX")
  1. MIKF ;EP KILL STATION DATA VARIABLES
  1.  K ASUMS
  1.  Q
  1. ASUSRIDX ;INDEX FIELDS OF STATION MASTER
  1.  ;WAR 3/2/2000 - changed next line... see the line below, it for change
  1.  ;There was a problem with STD DLY Rpts when the IDX was deleted
  1.  ;S ASUMS("E#","IDX")=$P(ASUMS(0),U)
  1.  I ($G(ASUMS("E#","IDX"))="")&(($P(ASUMS(0),U))'[999999) D
  1.  .S ASUMS("E#","IDX")=$P(ASUMS(0),U)
  1.  S ASUMS("ORD#")=$P(ASUMS(0),U,3)
  1.  N X S (X,ASUMS("SRC"))=$P(ASUMS(0),U,4) D:X]"" SRC^ASULDIRF(X)
  1.  S ASUMS("LTM")=$P(ASUMS(0),U,5)
  1.  S ASUMS("RPQ-O")=$P(ASUMS(0),U,6)
  1.  S ASUMS("PMIQ")=$P(ASUMS(0),U,7)
  1.  S ASUMS("RPQ")=$P(ASUMS(0),U,8)
  1.  S ASUMS("LSTISS")=$P(ASUMS(0),U,13)
  1.  S ASUMS("VENAM")=$P(ASUMS(0),U,14)
  1.  S ASUMS("LPP")=$P(ASUMS(0),U,15)
  1.  S ASUMS("PMIV")=$FN((ASUMS("PMIQ")*ASUMS("LPP")),"",0)
  1.  S ASUMS("VAL","O/H")=$P(ASUMS(0),U,16)
  1.  S ASUMS("QTY","O/H")=+($P(ASUMS(0),U,17))
  1.  I ASUMS("QTY","O/H")=0 D
  1.  .S ASUMS("CST/U")=ASUMS("LPP")
  1.  E  D
  1.  .S ASUMS("CST/U")=$FN((ASUMS("VAL","O/H")/ASUMS("QTY","O/H")),"",2)
  1.  S ASUMS("D/I","QTY",1)=$P(ASUMS(0),U,18)
  1.  S ASUMS("D/I","VAL",1)=$P(ASUMS(0),U,19)
  1.  S ASUMS("D/I","PO#",1)=$P(ASUMS(0),U,20)
  1.  S ASUMS("D/I","DT",1)=$P(ASUMS(0),U,21)
  1.  S ASUMS("D/I","SSA",1)=$P(ASUMS(0),U,22)
  1.  S ASUMS("D/I","QTY",2)=$P(ASUMS(0),U,23)
  1.  S ASUMS("D/I","VAL",2)=$P(ASUMS(0),U,24)
  1.  S ASUMS("D/I","PO#",2)=$P(ASUMS(0),U,25)
  1.  S ASUMS("D/I","DT",2)=$P(ASUMS(0),U,26)
  1.  S ASUMS("D/I","SSA",2)=$P(ASUMS(0),U,27)
  1.  S ASUMS("D/I","QTY",3)=$P(ASUMS(0),U,28)
  1.  S ASUMS("D/I","VAL",3)=$P(ASUMS(0),U,29)
  1.  S ASUMS("D/I","PO#",3)=$P(ASUMS(0),U,30)
  1.  S ASUMS("D/I","DT",3)=$P(ASUMS(0),U,31)
  1.  S ASUMS("D/I","VAL-TOT")=ASUMS("D/I","VAL",1)+ASUMS("D/I","VAL",2)+ASUMS("D/I","VAL",3)
  1.  S ASUMS("D/I","QTY-TOT")=ASUMS("D/I","QTY",1)+ASUMS("D/I","QTY",2)+ASUMS("D/I","QTY",3)
  1.  S ASUMS("D/I","SSA",3)=$P(ASUMS(0),U,32)
  1.  N X S (X,ASUMS("SLC"))=$P(ASUMS(2),U) D SLC^ASULDIRR(X)
  1.  S ASUMS("D/O","QTY")=$S($P(ASUMS(2),U,2)>0:$P(ASUMS(2),U,2),1:0)
  1.  S ASUMS("VENUI")=$P(ASUMS(2),U,3)
  1.  S ASUMS("SFSKM")=$P(ASUMS(2),U,4)
  1.  S ASUMS("SPQ")=$P(ASUMS(2),U,6)
  1.  D EOQ
  1.  S ASUMS("VALBEG")=$P(ASUMS(2),U,7)
  1.  S ASUMS("QTY-BEG")=$P(ASUMS(2),U,8)
  1.  S ASUMS("D/I","DTR72",1)=$P(ASUMS(2),U,9)
  1.  S ASUMS("D/I","DTR72",2)=$P(ASUMS(2),U,10)
  1.  S ASUMS("D/I","DTR72",3)=$P(ASUMS(2),U,11)
  1.  S ASUMS("R73","REM")=$P(ASUMS(3),U)
  1.  S ASUMS("R73","PER")=$P(ASUMS(3),U,2)
  1.  S ASUMS("R73","DT")=$P(ASUMS(3),U,3)
  1.  S ASUMS("R13","TIMES")=$P(ASUMS(3),U,4)
  1.  Q
  1. EOQ ;
  1.  S ASUMS("EOQ","TP")=$P(ASUMS(2),U,5)
  1.  I ASUMS("EOQ","TP")]"" D
  1.  .D EOQ^ASULDIRF(ASUMS("EOQ","TP"))
  1.  S ASUMS("STKST")=ASUMS("QTY","O/H")+ASUMS("D/I","QTY-TOT")-ASUMS("D/O","QTY")
  1.  S ASUMS("EOQ","TB")=$P(ASUMS(0),U,9)
  1.  I ASUMS("EOQ","TB")]"" D
  1.  .D EOQT^ASULDIRF(ASUMS("EOQ","TB"))
  1.  .I Y<0 D STA^ASULARST(ASUMS("E#","STA")) S ASUMS("EOQ","TB")=$S(ASUL(2,"STA","EOQTB")="":50,1:ASUL(2,"STA","EOQTB"))
  1.  E  D
  1.  .D STA^ASULARST(ASUMS("E#","STA")) S ASUMS("EOQ","TB")=$S(ASUL(2,"STA","EOQTB")="":50,1:ASUL(2,"STA","EOQTB"))
  1.  I ASUMS("EOQ","TB")="" S ASUMS("EOQ","TB")=50
  1.  D EOQT^ASULDIRF(ASUMS("EOQ","TB"))
  1.  S ASUMS("EOQ","MM")=$P(ASUMS(0),U,10)
  1.  S ASUMS("EOQ","QM")=$P(ASUMS(0),U,11)
  1.  S ASUMS("EOQ","AM")=$P(ASUMS(0),U,12)
  1.  S (ASUU(19),ASUF("EOQ"))=0
  1.  F  S ASUU(19)=$O(ASUL(8,"EOQTB",ASUU(19))) Q:ASUU(19)=""  Q:ASUF("EOQ")  D
  1.  .S ASUMS("EOQ","MO")=$P(ASUL(8,"EOQTB",ASUU(19)),U,2)
  1.  .I $P(ASUL(8,"EOQTB",ASUU(19)),U)>ASUMS("PMIV") S ASUF("EOQ")=1
  1.  K ASUF("EOQ")
  1.  F ASUU(19)=1:1:4 I $E(ASUMS("EOQ","AM"),ASUU(19),ASUU(19))=0 D
  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.  K ASUU(19)
  1.  I "ADFQS"[ASUMS("EOQ","TP") D  Q
  1.  .S ASUMS("EOQ","QTY")=(ASUMS("PMIQ")*ASUMS("EOQ","MO"))+ASUMS("RPQ")-ASUMS("STKST")
  1.  .I ASUMS("EOQ","QTY")<0 S:"AQS"[ASUMS("EOQ","TP") ASUMS("EOQ","QTY")=0
  1.  I "B"[ASUMS("EOQ","TP") D  Q
  1.  .S ASUMS("EOQ","QTY")=(ASUMS("PMIQ")*ASUMS("EOQ","MO"))+ASUMS("RPQ")-ASUMS("STKST")
  1.  .S ASUV("EOQ")=ASUMS("EOQ","QM")+ASUMS("RPQ")-ASUMS("STKST")-ASUMS("PMIQ")
  1.  .S:ASUMS("EOQ","QM")<ASUV("EOQ") ASUV("EOQ")=ASUMS("EOQ","QM")
  1.  .S:ASUV("EOQ")<ASUMS("EOQ","QTY") ASUMS("EOQ","QTY")=ASUV("EOQ")
  1.  I "C"[ASUMS("EOQ","TP") D  Q
  1.  .S ASUMS("EOQ","QTY")=(ASUMS("PMIQ")*ASUMS("EOQ","MO"))+ASUMS("RPQ")-ASUMS("STKST")
  1.  .S ASUV("EOQ")=(ASUMS("EOQ","MM")*ASUMS("PMIQ"))+ASUMS("RPQ")-ASUMS("STKST")-ASUMS("PMIQ")
  1.  .S ASUV("EOQ",2)=ASUMS("EOQ","MM")*ASUMS("PMIQ")
  1.  .S:ASUV("EOQ",2)<ASUV("EOQ") ASUV("EOQ")=ASUV("EOQ",2)
  1.  .S:ASUV("EOQ")<ASUMS("EOQ","QTY") ASUMS("EOQ","QTY")=ASUV("EOQ")
  1.  I "PYR"[ASUMS("EOQ","TP") S ASUMS("EOQ","QTY")=0
  1.  S ASUMS("EOQ","QTY")=$FN(ASUMS("EOQ","QTY"),"",0)
  1.  N X S X=ASUMS("EOQ","QTY"),Y="" D EOQ^ASU3ISQA(.X,.Y) S ASUMS("EOQ","QTY")=Y
  1.  Q
  1. MIC ;EP SET DEMAND DATA
  1.  Q:$G(ASUMS("E#","STA"))=""
  1.  Q:$G(ASUMS("E#","IDX"))=""
  1.  S (ASUMS("DMD","QTY"),ASUMS("DMD","CALL"))=0
  1.  F ASUV("MO")=1:1:12 D MMC
  1.  N X S X2=ASUMS("ESTB"),X1=ASUK("DT","FM") D ^%DTC S ASUMS("ESTB","MO")=$FN((X/30),"",0) S:ASUMS("ESTB","MO")=0 ASUMS("ESTB","MO")=1
  1.  I ASUMS("ESTB","MO")>11 D
  1.  .S ASUMS("AMIQ")=$FN((ASUMS("DMD","QTY")/12),"",0)
  1.  E  D
  1.  .S ASUMS("AMIQ")=$FN((ASUMS("DMD","QTY")/ASUMS("ESTB","MO")),"",0)
  1.  K ASUV("MO"),ASUMS("DMD",0)
  1.  Q
  1. MICK ;EP KILL DEMAND DATA
  1.  K ASUMS("DMD")
  1.  Q
  1. MMC ;MONTH
  1.  S ASUMS("DMD",0)=""
  1.  S:$D(^ASUMS(ASUMS("E#","STA"),1,ASUMS("E#","IDX"),1,ASUV("MO"),0)) ASUMS("DMD",0)=^ASUMS(ASUMS("E#","STA"),1,ASUMS("E#","IDX"),1,ASUV("MO"),0)
  1.  S ASUMS("DMD","CALL",ASUV("MO"))=+($P(ASUMS("DMD",0),U,2))
  1.  S ASUMS("DMD","CALL")=$G(ASUMS("DMD","CALL"))+ASUMS("DMD","CALL",ASUV("MO"))
  1.  S ASUMS("DMD","QTY",ASUV("MO"))=+($P(ASUMS("DMD",0),U,3))
  1.  S ASUMS("DMD","QTY")=$G(ASUMS("DMD","QTY"))+ASUMS("DMD","QTY",ASUV("MO"))
  1. MEXP ;SET EXPIRATION VARIABLES
  1.  N X,Y
  1.  S ASUMS("E#","DXP")=0,ASUMS("DXP",0)=0
  1.  F ASUMS("DXP")=0:1 S ASUMS("E#","DXP")=$O(^ASUMS(ASUMS("E#","STA"),1,ASUMS("E#","IDX"),4,ASUMS("E#","DXP"))) Q:ASUMS("E#","DXP")'?1N.N  D
  1.  .S X=ASUMS("DXP")+1
  1.  .S Y=$P(^ASUMS(ASUMS("E#","STA"),1,ASUMS("E#","IDX"),4,ASUMS("E#","DXP"),0),U)
  1.  .S ASUMS("DXP",Y)=$P(^ASUMS(ASUMS("E#","STA"),1,ASUMS("E#","IDX"),4,ASUMS("E#","DXP"),0),U,2)
  1.  .S ASUMS("DXP",0)=ASUMS("DXP",0)+ASUMS("DXP",Y),ASUMS("DXP",Y)=ASUMS("DXP",Y)_U_X
  1.  I ASUMS("DXP",0)'>ASUMS("QTY","O/H") Q
  1.  S X=9999999,Y=ASUMS("QTY","O/H")
  1.  F  S X=$O(ASUMS("DXP",X),-1) Q:X'?1N.N  D
  1.  .I Y=0 K ASUMS("DXP",X) Q
  1.  .I $P(ASUMS("DXP",X),U)<Y S Y=Y-$P(ASUMS("DXP",X),U) Q
  1.  .S ASUMS("DXP",X)=Y,Y=0
  1.  S (X,Y)=0
  1.  F  S X=$O(ASUMS("DXP",X)) Q:X=""  S Y=Y+1,ASUMS("DXP",X)=ASUMS("DXP",X)_U_Y
  1.  S ASUMS("DXP")=Y
  1.  Q
  1. READ(X) ;EP ;WITH PARAMETER PASSING
  1.  ; X = INDEX POINTER
  1.  ;D:X'?8N IDX^ASULDIRR(.X) S ASUMS("E#","IDX")=X
  1.  Q:X=""
  1.  G M