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