ASUJSAVE ; IHS/ITSC/LMH -SCREENMAN SAVE ARRAY ;
;;4.2T2;Supply Accounting Mgmt. System;;JUN 30, 2000
;This routine will be used to set local array field variables
ACC(X) ;EP;Account
S ASUT(ASUT,"ACC")=ASUL(9,"ACC"),ASUT(ASUT,"PT","ACC")=ASUL(9,"ACC","E#") Q:$G(ASUSB)=1
D PUT^DDSVAL(DIE,.DA,.04,ASUL(9,"ACC","E#"),"","I"),PUT^DDSVAL(DIE,.DA,4,ASUL(9,"ACC")) Q
ARE(X) ;EP;Area
S ASUT(ASUT,"AR","CD")=ASUL(1,"AR","AP"),ASUT(ASUT,"PT","AR")=ASUL(1,"AR","E#") Q:$G(ASUSB)=1
D PUT^DDSVAL(DIE,.DA,.02,ASUL(1,"AR","E#"),"","I"),PUT^DDSVAL(DIE,.DA,2,ASUL(1,"AR","AP")) Q
AUI(X) ;EP;Area Unit of Issue
S ASUT(ASUT,"AR U/I")=$G(X) Q:$G(ASUSB)=1
D PUT^DDSVAL(DIE,.DA,42,ASUT(ASUT,"AR U/I")) Q
BCD(X) ;EP;Bar Code
S ASUT(ASUT,"BCD")=$G(X) Q:$G(ASUSB)=1
E D PUT^DDSVAL(DIE,.DA,45,ASUT(ASUT,"BCD")) Q
CAN(X) ;EP;Common Accounting #
CANA ;
S ASUT(ASUT,"CAN")=$G(X) Q:ASUT("TYPE")=2 Q:$G(ASUSB)=1
D PUT^DDSVAL(DIE,.DA,15,ASUT(ASUT,"CAN")) Q
DCAN(X) ;EP;Direct CAN
G CANA
CAT(X) ;EP;Category
S ASUT(ASUT,"CAT")=$G(ASUL(7,"CAT","CD")),ASUT(ASUT,"PT","CAT")=$G(ASUL(7,"CAT","E#")),ASUT(ASUT,"CAT NM")=$G(ASUL(7,"CAT","NM")) Q:$G(ASUSB)=1
D PUT^DDSVAL(DIE,.DA,49,$G(ASUL(7,"CAT","CD"))),PUT^DDSVAL(DIE,.DA,.19,$G(ASUL(7,"CAT","E#")),"","I") Q
CTG(X) ;EP;Contract Grant #
S ASUT(ASUT,"CTG")=$G(X) Q:$G(ASUSB)=1
D PUT^DDSVAL(DIE,.DA,35,ASUT(ASUT,"CTG")) Q
FPN(X) ;EP;F P or N fill
S ASUT(ASUT,"FPN")=$G(X) Q:$G(ASUSB)=1
D PUT^DDSVAL(DIE,.DA,18,ASUT(ASUT,"FPN")) Q
DESC(X) ;EP;Description
S ASUT(ASUT,"DESC")=$G(X) Q:$G(ASUSB)=1
D PUT^DDSVAL(DIE,.DA,41,ASUT(ASUT,"DESC")) Q
DSO(X) ;EP;Direct Sub Object
S ASUT(ASUT,"SOBJ")=ASUL(4,"SOBJ","CD"),ASUT(ASUT,"PT","SOBJ")=ASUL(4,"SOBJ","E#") Q:$G(ASUSB)=1
D PUT^DDSVAL(DIE,.DA,.17,ASUL(4,"SOBJ","E#"),"","I"),PUT^DDSVAL(DIE,.DA,17,$E(ASUL(4,"SOBJ","CD"),1,2)_$E(ASUL(4,"SOBJ","CD"),4,5)) Q
DTD(X) ;EP ;Date Due
S ASUT(ASUT,"DTD")=$G(X) Q:$G(ASUSB)=1
D PUT^DDSVAL(DIE,.DA,10,ASUT(ASUT,"DTD")) Q
DTE(X) ;EP;Date Established
S ASUT(ASUT,"DTS")=$G(X) Q:$G(ASUSB)=1
D PUT^DDSVAL(DIE,.DA,.07,ASUT(ASUT,"DTS")) Q
DTR(X) ;EP;Date of Request
S ASUT(ASUT,"DTE")=$G(X) Q:$G(ASUSB)=1
D PUT^DDSVAL(DIE,.DA,.07,ASUT(ASUT,"DTE")) Q
DTX(X) ;EP;Date Expired
S ASUT(ASUT,"DTX")=$G(X) Q:$G(ASUSB)=1
D PUT^DDSVAL(DIE,.DA,10,ASUT(ASUT,"DTX")) Q
EOQ(X) ;EP;Eoq type
S ASUT(ASUT,"EOQ TYP")=$G(ASUL(6,"EOQTP")) Q:$G(ASUSB)=1
D PUT^DDSVALF("EQTNM","","",$G(ASUL(6,"EOQTP","NM"))),PUT^DDSVAL(DIE,.DA,16,ASUT(ASUT,"EOQ TYP")) Q
EQMM(X) ;EP;Eoq months mod
S ASUT(ASUT,"EOQ MM")=$G(X) Q:$G(ASUSB)=1
D PUT^DDSVAL(DIE,.DA,52,ASUT(ASUT,"EOQ MM")) Q
EQAM(X) ;EP;Eoq Action mod
N Z S ASUT(ASUT,"EOQ AM")=$G(X) F Z=1:1:3 S ASUT(ASUT,"EOQ AM",Z)=$E(ASUT(ASUT,"EOQ AM"),Z)
S ASUT(ASUT,"EOQ AM",4)=$E(ASUT(ASUT,"EOQ AM"),4,5) Q:$G(ASUSB)=1
D PUT^DDSVAL(DIE,.DA,54,ASUT(ASUT,"EOQ AM")) Q
EQQM(X) ;EP;Eoq qty mod
S ASUT(ASUT,"EOQ QM")=$G(X) Q:$G(ASUSB)=1
D PUT^DDSVAL(DIE,.DA,53,ASUT(ASUT,"EOQ QM")) Q
IDX(X) ;EP;Index info
I $G(ASUT(ASUT,"PT","IDX"))']"" D
.I $G(ASUMX("E#","IDX"))]"" S ASUT(ASUT,"PT","IDX")=ASUMX("E#","IDX"),ASUT(ASUT,"IDX")=ASUMX("IDX")
I $G(ASUSB)=1 W "."
E D PUT^DDSVAL(DIE,.DA,.05,ASUT(ASUT,"PT","IDX"),"","I"),PUT^DDSVAL(DIE,.DA,5,ASUT(ASUT,"IDX"))
Q:$G(ASUT("TRCD"))="4A" N Z S Z=ASUL(9,"ACC") D ACC(.Z) Q:$E(ASUT("TRCD"))=4 D SIDXD
Q
SIDXD ;
Q:$G(ASUSB)=1
I $G(ASUT("TRCD"))="5A" Q
K DIERR S IENS=ASUMS("E#","STA")_","_ASUMS("E#","IDX")_","
N Z S Z=ASUMS("SRC")_" "_$G(ASUL(5,"SRC","NM")) D PUT^DDSVALF("SRC","ASUJSTIX","",Z,"E",IENS)
I ($G(ASUT("TYPE"))'=2)&($G(ASUT("TYPE"))'=0) D PUT^DDSVALF("VEN","ASUJSTIX","",ASUMS("VENAM"),"E",IENS)
D PUT^DDSVALF("ORD","ASUJSTIX","",ASUMS("ORD#"),"E",IENS),PUT^DDSVALF("VENUI","ASUJSTIX","",ASUMS("VENUI"),"E",IENS)
N Z S Z=ASUMS("EOQ","TP")_" "_$G(ASUL(6,"EOQTP","NM")) D PUT^DDSVALF("EOQTP","ASUJSTIX","",Z,"",IENS)
D PUT^DDSVALF("EOQMM","ASUJSTIX","",ASUMS("EOQ","MM"),"E",IENS),PUT^DDSVALF("EOQQM","ASUJSTIX","",ASUMS("EOQ","QM"),"E",IENS)
D PUT^DDSVALF("EQAM","ASUJSTIX","",ASUMS("EOQ","AM"),"E",IENS),PUT^DDSVALF("EOQTB","ASUJSTIX","",ASUMS("EOQ","TB"),"E",IENS)
N Z S Z=$FN(ASUMS("CST/U"),"",2) D PUT^DDSVALF("CST/U","ASUJSTIX","",Z,"E",IENS)
D PUT^DDSVALF("SPQ","ASUJSTIX","",ASUMS("SPQ"),"E",IENS),PUT^DDSVALF("RPQ","ASUJSTIX","",ASUMS("RPQ"),"E",IENS),PUT^DDSVALF("LTM","ASUJSTIX","",ASUMS("LTM"),"E",IENS)
N Z S Z=ASUMS("SLC")_" "_$G(ASUL(10,"SLC","NM")) D PUT^DDSVALF("SLC","ASUJSTIX","",Z,"E",IENS)
D PUT^DDSVALF("QTYOH","ASUJSTIX","",ASUMS("QTY","O/H"),"E",IENS),PUT^DDSVALF("DUEOUT","ASUJSTIX","",ASUMS("D/O","QTY"),"E",IENS),PUT^DDSVALF("DUEIN","ASUJSTIX","",ASUMS("D/I","QTY-TOT"),"E",IENS)
D PUT^DDSVALF("PAMIQ","ASUJSTIX","",ASUMS("AMIQ"),"E",IENS)
N Z S Z=$FN(ASUMS("VAL","O/H"),"",2) D PUT^DDSVALF("VALOH","ASUJSTIX","",Z,"E",IENS)
N Z S Z=$FN(ASUMS("LPP"),"",2) D PUT^DDSVALF("LPP","ASUJSTIX","",Z,"E",IENS)
D PUT^DDSVALF("LSTISS","ASUJSTIX","",ASUMS("LSTISS"),"E",IENS)
N Z S Z=$E(ASUMS("ESTB"),4,5)_"/"_$E(ASUMS("ESTB"),6,7)_"/"_$E(ASUMS("ESTB"),2,3) D PUT^DDSVALF("SESTCHG","ASUJSTIX","",Z,"E",IENS)
Q
KEY(X) ;EP;.01 Key
S ASUT(ASUT,"TRKY")=$G(X) Q:$G(ASUSB)=1
D PUT^DDSVAL(DIE,.DA,.01,ASUT(ASUT,"TRKY")) Q
LTM(X) ;EP;Lead time months
S ASUT(ASUT,"LTM")=$FN($G(X),"",1) Q:$G(ASUSB)=1
D PUT^DDSVAL(DIE,.DA,55,ASUT(ASUT,"LTM")) Q
NSN(X) ;EP;National Stock #
S ASUT(ASUT,"NSN")=$G(X) I $G(ASUT("TRCD"))="4C" S ASUS("CHG")=1
Q:$G(ASUSB)=1
D PUT^DDSVAL(DIE,.DA,43,ASUT(ASUT,"NSN")) Q
ORD(X) ;EP;Order Number
S ASUT(ASUT,"ORD#")=$G(X) Q:$G(ASUSB)=1
D PUT^DDSVAL(DIE,.DA,9,ASUT(ASUT,"ORD#")) Q
PON(X) ;EP;Purchase Order #
S ASUT(ASUT,"PON")=$G(X) Q:$G(ASUSB)=1
D PUT^DDSVAL(DIE,.DA,9,ASUT(ASUT,"PON")) Q
PST(X) ;EP;Post
S ASUT(ASUT,"PST")=$G(X) Q:$G(ASUSB)=1
D PUT^DDSVAL(DIE,.DA,31,ASUT(ASUT,"PST")) Q
QTY(X) ;EP;Quantity
S (ASUT(ASUT,"QTY"),ASUT(ASUT,"QTY","REQ"))=$G(X) Q:$G(ASUSB)=1
D PUT^DDSVAL(DIE,.DA,6,ASUT(ASUT,"QTY")) Q
QTYI(X) ;EP;Quantity Issued
S ASUT(ASUT,"QTY","ISS")=$G(X) Q:$G(ASUSB)=1
D PUT^DDSVAL(DIE,.DA,36,ASUT(ASUT,"QTY","ISS")) Q
REQ(X) ;EP;Requsitioner
S ASUT(ASUT,"PT","REQ")=ASUL(20,"REQ","E#") Q:$G(ASUSB)=1
D PUT^DDSVAL(DIE,.DA,.15,ASUL(20,"REQ","E#"),"","I")
I ($G(ASUT("TYPE"))>0)&($G(ASUT("TYPE"))<5) D PUT^DDSVALF("HMARE","","",$E(ASUL(20,"REQ","E#"),1,2))
I ($E(ASUT("TRCD"))=3!($E(ASUT("TRCD"))="0")) D
.I $G(ASUL(20,"SSA","CNT"))=1 D
..N Z S Z=ASUL(20,"SSA") D SSA^ASULDIRR(.Z),SSA(.Z) S Z=ASUL(20,"CAN",ASUL(20,"SSA")) D CAN(.Z)
.E D
..;S DIC="^ASUL(20,"_ASUL(20,"REQ","E#")_",2,",DIC(0)="AEMQ",D="B",DZ="??" D DQ^DICQ
..N Z S Z=ASUL(20,"SSA") D SSA^ASULDIRR(.Z),SSA(.Z) S Z=ASUL(20,"CAN",ASUL(20,"SSA")) D CAN(.Z)
Q
RQN(X) ;EP;Request #
S ASUT(ASUT,"RQN")=$G(X) Q:$G(ASUSB)=1
D PUT^DDSVAL(DIE,.DA,34,ASUT(ASUT,"RQN")) Q
RPQ(X) ;EP;Review Point
S ASUT(ASUT,"RPQ")=$G(X) Q:$G(ASUSB)=1
D PUT^DDSVAL(DIE,.DA,56,ASUT(ASUT,"RPQ")) Q
RTP(X) ;EP;Request type
S ASUT(ASUT,"REQ TYP")=$G(X) Q:$G(ASUSB)=1
D PUT^DDSVAL(DIE,.DA,33,ASUT(ASUT,"REQ TYP")) Q
SLC(X) ;EP;Storage Location
S ASUT(ASUT,"SLC")=ASUL(10,"SLC"),ASUT(ASUT,"SLC","NM")=ASUL(10,"SLC","NM"),ASUT(ASUT,"PT","SLC")=ASUL(10,"SLC","E#") Q:$G(ASUSB)=1
D PUT^DDSVALF("SLCNM","","",ASUL(10,"SLC","NM")),PUT^DDSVAL(DIE,.DA,51,ASUL(10,"SLC")) Q
SPQ(X) ;EP;Standard Pack
S ASUT(ASUT,"SPQ")=$G(X) Q:$G(ASUSB)=1
D PUT^DDSVAL(DIE,.DA,61,ASUT(ASUT,"SPQ")) Q
SRC(X) ;EP;Source
S ASUT(ASUT,"SRC")=ASUL(5,"SRC"),ASUT(ASUT,"SRC","NM")=ASUL(5,"SRC","NM"),ASUT(ASUT,"PT","SRC")=ASUL(5,"SRC","E#") Q:$G(ASUSB)=1
D PUT^DDSVAL(DIE,.DA,12,ASUL(5,"SRC")),PUT^DDSVAL(DIE,.DA,.12,ASUL(5,"SRC","E#"),"","I") Q
SSA(X) ;EP ;Sub Sub Activity
S ASUT(ASUT,"SSA")=ASUL(17,"SSA"),ASUT(ASUT,"PT","SSA")=ASUL(17,"SSA","E#")
I $G(ASUSB)=1 W "."
E D PUT^DDSVAL(DIE,.DA,.11,ASUL(17,"SSA","E#"),"","I"),PUT^DDSVAL(DIE,.DA,11,ASUL(17,"SSA"))
Q:$G(ASUT("TYPE"))=7 Q:$G(ASUT("TYPE"))=8 Q:ASUT("TYPE")=2 Q:'$D(ASUL(20)) S ASUT(ASUT,"CAN")=$G(ASUL(20,"CAN",ASUT(ASUT,"SSA"))) Q:$G(ASUSB)=1
D PUT^DDSVAL(DIE,.DA,15,ASUT(ASUT,"CAN")) Q
SSO(X) ;EP;Stock Sub Object
S ASUT(ASUT,"SOBJ")=ASUL(3,"SOBJ","CD"),ASUT(ASUT,"PT","SOBJ")=ASUL(3,"SOBJ","E#") Q:$G(ASUSB)=1
D PUT^DDSVAL(DIE,.DA,.17,ASUL(3,"SOBJ","E#"),"","I"),PUT^DDSVAL(DIE,.DA,17,ASUL(3,"SOBJ","CD")) Q
SST(X) ;EP;Sub Station
S ASUT(ASUT,"SST")=ASUL(18,"SST"),ASUT(ASUT,"PT","SST")=ASUL(18,"SST","E#"),ASUT(ASUT,"SST","NM")=ASUL(18,"SST","NM") Q:$G(ASUSB)=1
D PUT^DDSVAL(DIE,.DA,13,ASUL(18,"SST")),PUT^DDSVAL(DIE,.DA,.13,ASUL(18,"SST","E#"),"","I") I $G(ASUL(19,"USR","E#"))]"" S Z=ASUL(19,"USR") D REQ(.Z)
Q
STA(X) ;EP;Station
S ASUT(ASUT,"STA")=ASUL(2,"STA","CD"),ASUT(ASUT,"PT","STA")=ASUL(2,"STA","E#") Q:$G(ASUSB)=1
D PUT^DDSVAL(DIE,.DA,3,ASUL(2,"STA","CD")),PUT^DDSVAL(DIE,.DA,.03,ASUL(2,"STA","E#"),"","I") Q
SUI(X) ;EP;Vendor Unit of Issue
S ASUT(ASUT,"SUI")=$G(X) S:ASUT("TRCD")="5C" ASUS("CHG")=1 Q:$G(ASUSB)=1
D PUT^DDSVAL(DIE,.DA,59,ASUT(ASUT,"SUI")) Q
TRN(X) ;EP;Transaction
S ASUT(ASUT,"TRCD")=$G(X) Q:$G(ASUSB)=1
D PUT^DDSVAL(DIE,.DA,1,ASUT(ASUT,"TRCD")),PUT^DDSVAL(DIE,.DA,.3,ASUT(ASUT,"TYPE")) Q
UCS(X) ;EP;Unit cost
S ASUT(ASUT,"UCS")=$FN($G(X),"",2) Q:$G(ASUSB)=1
D PUT^DDSVAL(DIE,.DA,57,ASUT(ASUT,"UCS")) Q
ULQ(X) ;EP;User Level Quantity
S ASUT(ASUT,"ULQ")=$G(X) Q:$G(ASUSB)=1
D PUT^DDSVAL(DIE,.DA,60,ASUT(ASUT,"ULQ")) Q
USR(X) ;EP;User
S ASUT(ASUT,"USR")=ASUL(19,"USR"),ASUT(ASUT,"PT","USR")=ASUL(19,"USR","E#")
I $G(ASUSB)=1 W "."
E D PUT^DDSVAL(DIE,.DA,14,ASUL(19,"USR")),PUT^DDSVAL(DIE,.DA,.14,ASUL(19,"USR","E#"),"","I")
I $G(ASUL(18,"SST","E#"))]"" S Z=ASUL(19,"USR") D REQ(.Z)
Q
VAL(X) ;EP;Value
S ASUT(ASUT,"VAL")=$FN($G(X),"",2) Q:$G(ASUSB)=1
D PUT^DDSVAL(DIE,.DA,7,ASUT(ASUT,"VAL")) Q
VEN(X) ;EP;Vendor
Q:ASUT("TYPE")=2 Q:ASUT("TYPE")=0 Q:$G(ASUSB)=1
D PUT^DDSVAL(DIE,.DA,58,ASUT(ASUT,"VEN NM")),PUT^DDSVAL(DIE,.DA,.19,ASUT(ASUT,"PT","VEN"),"","I") Q
VOU(X) ;EP;Voucher #
S X=$G(X) S:X'["-" X=$E(X,1,2)_"-"_$E(X,3,4)_"-"_$E(X,5,8) S ASUT(ASUT,"VOU")=X Q:$G(ASUSB)=1
D PUT^DDSVAL(DIE,.DA,8,ASUT(ASUT,"VOU")) Q
ASUJSAVE ; IHS/ITSC/LMH -SCREENMAN SAVE ARRAY ;
+1 ;;4.2T2;Supply Accounting Mgmt. System;;JUN 30, 2000
+2 ;This routine will be used to set local array field variables
ACC(X) ;EP;Account
+1 SET ASUT(ASUT,"ACC")=ASUL(9,"ACC")
SET ASUT(ASUT,"PT","ACC")=ASUL(9,"ACC","E#")
IF $GET(ASUSB)=1
QUIT
+2 DO PUT^DDSVAL(DIE,.DA,.04,ASUL(9,"ACC","E#"),"","I")
DO PUT^DDSVAL(DIE,.DA,4,ASUL(9,"ACC"))
QUIT
ARE(X) ;EP;Area
+1 SET ASUT(ASUT,"AR","CD")=ASUL(1,"AR","AP")
SET ASUT(ASUT,"PT","AR")=ASUL(1,"AR","E#")
IF $GET(ASUSB)=1
QUIT
+2 DO PUT^DDSVAL(DIE,.DA,.02,ASUL(1,"AR","E#"),"","I")
DO PUT^DDSVAL(DIE,.DA,2,ASUL(1,"AR","AP"))
QUIT
AUI(X) ;EP;Area Unit of Issue
+1 SET ASUT(ASUT,"AR U/I")=$GET(X)
IF $GET(ASUSB)=1
QUIT
+2 DO PUT^DDSVAL(DIE,.DA,42,ASUT(ASUT,"AR U/I"))
QUIT
BCD(X) ;EP;Bar Code
+1 SET ASUT(ASUT,"BCD")=$GET(X)
IF $GET(ASUSB)=1
QUIT
+2 IF '$TEST
DO PUT^DDSVAL(DIE,.DA,45,ASUT(ASUT,"BCD"))
QUIT
CAN(X) ;EP;Common Accounting #
CANA ;
+1 SET ASUT(ASUT,"CAN")=$GET(X)
IF ASUT("TYPE")=2
QUIT
IF $GET(ASUSB)=1
QUIT
+2 DO PUT^DDSVAL(DIE,.DA,15,ASUT(ASUT,"CAN"))
QUIT
DCAN(X) ;EP;Direct CAN
+1 GOTO CANA
CAT(X) ;EP;Category
+1 SET ASUT(ASUT,"CAT")=$GET(ASUL(7,"CAT","CD"))
SET ASUT(ASUT,"PT","CAT")=$GET(ASUL(7,"CAT","E#"))
SET ASUT(ASUT,"CAT NM")=$GET(ASUL(7,"CAT","NM"))
IF $GET(ASUSB)=1
QUIT
+2 DO PUT^DDSVAL(DIE,.DA,49,$GET(ASUL(7,"CAT","CD")))
DO PUT^DDSVAL(DIE,.DA,.19,$GET(ASUL(7,"CAT","E#")),"","I")
QUIT
CTG(X) ;EP;Contract Grant #
+1 SET ASUT(ASUT,"CTG")=$GET(X)
IF $GET(ASUSB)=1
QUIT
+2 DO PUT^DDSVAL(DIE,.DA,35,ASUT(ASUT,"CTG"))
QUIT
FPN(X) ;EP;F P or N fill
+1 SET ASUT(ASUT,"FPN")=$GET(X)
IF $GET(ASUSB)=1
QUIT
+2 DO PUT^DDSVAL(DIE,.DA,18,ASUT(ASUT,"FPN"))
QUIT
DESC(X) ;EP;Description
+1 SET ASUT(ASUT,"DESC")=$GET(X)
IF $GET(ASUSB)=1
QUIT
+2 DO PUT^DDSVAL(DIE,.DA,41,ASUT(ASUT,"DESC"))
QUIT
DSO(X) ;EP;Direct Sub Object
+1 SET ASUT(ASUT,"SOBJ")=ASUL(4,"SOBJ","CD")
SET ASUT(ASUT,"PT","SOBJ")=ASUL(4,"SOBJ","E#")
IF $GET(ASUSB)=1
QUIT
+2 DO PUT^DDSVAL(DIE,.DA,.17,ASUL(4,"SOBJ","E#"),"","I")
DO PUT^DDSVAL(DIE,.DA,17,$EXTRACT(ASUL(4,"SOBJ","CD"),1,2)_$EXTRACT(ASUL(4,"SOBJ","CD"),4,5))
QUIT
DTD(X) ;EP ;Date Due
+1 SET ASUT(ASUT,"DTD")=$GET(X)
IF $GET(ASUSB)=1
QUIT
+2 DO PUT^DDSVAL(DIE,.DA,10,ASUT(ASUT,"DTD"))
QUIT
DTE(X) ;EP;Date Established
+1 SET ASUT(ASUT,"DTS")=$GET(X)
IF $GET(ASUSB)=1
QUIT
+2 DO PUT^DDSVAL(DIE,.DA,.07,ASUT(ASUT,"DTS"))
QUIT
DTR(X) ;EP;Date of Request
+1 SET ASUT(ASUT,"DTE")=$GET(X)
IF $GET(ASUSB)=1
QUIT
+2 DO PUT^DDSVAL(DIE,.DA,.07,ASUT(ASUT,"DTE"))
QUIT
DTX(X) ;EP;Date Expired
+1 SET ASUT(ASUT,"DTX")=$GET(X)
IF $GET(ASUSB)=1
QUIT
+2 DO PUT^DDSVAL(DIE,.DA,10,ASUT(ASUT,"DTX"))
QUIT
EOQ(X) ;EP;Eoq type
+1 SET ASUT(ASUT,"EOQ TYP")=$GET(ASUL(6,"EOQTP"))
IF $GET(ASUSB)=1
QUIT
+2 DO PUT^DDSVALF("EQTNM","","",$GET(ASUL(6,"EOQTP","NM")))
DO PUT^DDSVAL(DIE,.DA,16,ASUT(ASUT,"EOQ TYP"))
QUIT
EQMM(X) ;EP;Eoq months mod
+1 SET ASUT(ASUT,"EOQ MM")=$GET(X)
IF $GET(ASUSB)=1
QUIT
+2 DO PUT^DDSVAL(DIE,.DA,52,ASUT(ASUT,"EOQ MM"))
QUIT
EQAM(X) ;EP;Eoq Action mod
+1 NEW Z
SET ASUT(ASUT,"EOQ AM")=$GET(X)
FOR Z=1:1:3
SET ASUT(ASUT,"EOQ AM",Z)=$EXTRACT(ASUT(ASUT,"EOQ AM"),Z)
+2 SET ASUT(ASUT,"EOQ AM",4)=$EXTRACT(ASUT(ASUT,"EOQ AM"),4,5)
IF $GET(ASUSB)=1
QUIT
+3 DO PUT^DDSVAL(DIE,.DA,54,ASUT(ASUT,"EOQ AM"))
QUIT
EQQM(X) ;EP;Eoq qty mod
+1 SET ASUT(ASUT,"EOQ QM")=$GET(X)
IF $GET(ASUSB)=1
QUIT
+2 DO PUT^DDSVAL(DIE,.DA,53,ASUT(ASUT,"EOQ QM"))
QUIT
IDX(X) ;EP;Index info
+1 IF $GET(ASUT(ASUT,"PT","IDX"))']""
Begin DoDot:1
+2 IF $GET(ASUMX("E#","IDX"))]""
SET ASUT(ASUT,"PT","IDX")=ASUMX("E#","IDX")
SET ASUT(ASUT,"IDX")=ASUMX("IDX")
End DoDot:1
+3 IF $GET(ASUSB)=1
WRITE "."
+4 IF '$TEST
DO PUT^DDSVAL(DIE,.DA,.05,ASUT(ASUT,"PT","IDX"),"","I")
DO PUT^DDSVAL(DIE,.DA,5,ASUT(ASUT,"IDX"))
+5 IF $GET(ASUT("TRCD"))="4A"
QUIT
NEW Z
SET Z=ASUL(9,"ACC")
DO ACC(.Z)
IF $EXTRACT(ASUT("TRCD"))=4
QUIT
DO SIDXD
+6 QUIT
SIDXD ;
+1 IF $GET(ASUSB)=1
QUIT
+2 IF $GET(ASUT("TRCD"))="5A"
QUIT
+3 KILL DIERR
SET IENS=ASUMS("E#","STA")_","_ASUMS("E#","IDX")_","
+4 NEW Z
SET Z=ASUMS("SRC")_" "_$GET(ASUL(5,"SRC","NM"))
DO PUT^DDSVALF("SRC","ASUJSTIX","",Z,"E",IENS)
+5 IF ($GET(ASUT("TYPE"))'=2)&($GET(ASUT("TYPE"))'=0)
DO PUT^DDSVALF("VEN","ASUJSTIX","",ASUMS("VENAM"),"E",IENS)
+6 DO PUT^DDSVALF("ORD","ASUJSTIX","",ASUMS("ORD#"),"E",IENS)
DO PUT^DDSVALF("VENUI","ASUJSTIX","",ASUMS("VENUI"),"E",IENS)
+7 NEW Z
SET Z=ASUMS("EOQ","TP")_" "_$GET(ASUL(6,"EOQTP","NM"))
DO PUT^DDSVALF("EOQTP","ASUJSTIX","",Z,"",IENS)
+8 DO PUT^DDSVALF("EOQMM","ASUJSTIX","",ASUMS("EOQ","MM"),"E",IENS)
DO PUT^DDSVALF("EOQQM","ASUJSTIX","",ASUMS("EOQ","QM"),"E",IENS)
+9 DO PUT^DDSVALF("EQAM","ASUJSTIX","",ASUMS("EOQ","AM"),"E",IENS)
DO PUT^DDSVALF("EOQTB","ASUJSTIX","",ASUMS("EOQ","TB"),"E",IENS)
+10 NEW Z
SET Z=$FNUMBER(ASUMS("CST/U"),"",2)
DO PUT^DDSVALF("CST/U","ASUJSTIX","",Z,"E",IENS)
+11 DO PUT^DDSVALF("SPQ","ASUJSTIX","",ASUMS("SPQ"),"E",IENS)
DO PUT^DDSVALF("RPQ","ASUJSTIX","",ASUMS("RPQ"),"E",IENS)
DO PUT^DDSVALF("LTM","ASUJSTIX","",ASUMS("LTM"),"E",IENS)
+12 NEW Z
SET Z=ASUMS("SLC")_" "_$GET(ASUL(10,"SLC","NM"))
DO PUT^DDSVALF("SLC","ASUJSTIX","",Z,"E",IENS)
+13 DO PUT^DDSVALF("QTYOH","ASUJSTIX","",ASUMS("QTY","O/H"),"E",IENS)
DO PUT^DDSVALF("DUEOUT","ASUJSTIX","",ASUMS("D/O","QTY"),"E",IENS)
DO PUT^DDSVALF("DUEIN","ASUJSTIX","",ASUMS("D/I","QTY-TOT"),"E",IENS)
+14 DO PUT^DDSVALF("PAMIQ","ASUJSTIX","",ASUMS("AMIQ"),"E",IENS)
+15 NEW Z
SET Z=$FNUMBER(ASUMS("VAL","O/H"),"",2)
DO PUT^DDSVALF("VALOH","ASUJSTIX","",Z,"E",IENS)
+16 NEW Z
SET Z=$FNUMBER(ASUMS("LPP"),"",2)
DO PUT^DDSVALF("LPP","ASUJSTIX","",Z,"E",IENS)
+17 DO PUT^DDSVALF("LSTISS","ASUJSTIX","",ASUMS("LSTISS"),"E",IENS)
+18 NEW Z
SET Z=$EXTRACT(ASUMS("ESTB"),4,5)_"/"_$EXTRACT(ASUMS("ESTB"),6,7)_"/"_$EXTRACT(ASUMS("ESTB"),2,3)
DO PUT^DDSVALF("SESTCHG","ASUJSTIX","",Z,"E",IENS)
+19 QUIT
KEY(X) ;EP;.01 Key
+1 SET ASUT(ASUT,"TRKY")=$GET(X)
IF $GET(ASUSB)=1
QUIT
+2 DO PUT^DDSVAL(DIE,.DA,.01,ASUT(ASUT,"TRKY"))
QUIT
LTM(X) ;EP;Lead time months
+1 SET ASUT(ASUT,"LTM")=$FNUMBER($GET(X),"",1)
IF $GET(ASUSB)=1
QUIT
+2 DO PUT^DDSVAL(DIE,.DA,55,ASUT(ASUT,"LTM"))
QUIT
NSN(X) ;EP;National Stock #
+1 SET ASUT(ASUT,"NSN")=$GET(X)
IF $GET(ASUT("TRCD"))="4C"
SET ASUS("CHG")=1
+2 IF $GET(ASUSB)=1
QUIT
+3 DO PUT^DDSVAL(DIE,.DA,43,ASUT(ASUT,"NSN"))
QUIT
ORD(X) ;EP;Order Number
+1 SET ASUT(ASUT,"ORD#")=$GET(X)
IF $GET(ASUSB)=1
QUIT
+2 DO PUT^DDSVAL(DIE,.DA,9,ASUT(ASUT,"ORD#"))
QUIT
PON(X) ;EP;Purchase Order #
+1 SET ASUT(ASUT,"PON")=$GET(X)
IF $GET(ASUSB)=1
QUIT
+2 DO PUT^DDSVAL(DIE,.DA,9,ASUT(ASUT,"PON"))
QUIT
PST(X) ;EP;Post
+1 SET ASUT(ASUT,"PST")=$GET(X)
IF $GET(ASUSB)=1
QUIT
+2 DO PUT^DDSVAL(DIE,.DA,31,ASUT(ASUT,"PST"))
QUIT
QTY(X) ;EP;Quantity
+1 SET (ASUT(ASUT,"QTY"),ASUT(ASUT,"QTY","REQ"))=$GET(X)
IF $GET(ASUSB)=1
QUIT
+2 DO PUT^DDSVAL(DIE,.DA,6,ASUT(ASUT,"QTY"))
QUIT
QTYI(X) ;EP;Quantity Issued
+1 SET ASUT(ASUT,"QTY","ISS")=$GET(X)
IF $GET(ASUSB)=1
QUIT
+2 DO PUT^DDSVAL(DIE,.DA,36,ASUT(ASUT,"QTY","ISS"))
QUIT
REQ(X) ;EP;Requsitioner
+1 SET ASUT(ASUT,"PT","REQ")=ASUL(20,"REQ","E#")
IF $GET(ASUSB)=1
QUIT
+2 DO PUT^DDSVAL(DIE,.DA,.15,ASUL(20,"REQ","E#"),"","I")
+3 IF ($GET(ASUT("TYPE"))>0)&($GET(ASUT("TYPE"))<5)
DO PUT^DDSVALF("HMARE","","",$EXTRACT(ASUL(20,"REQ","E#"),1,2))
+4 IF ($EXTRACT(ASUT("TRCD"))=3!($EXTRACT(ASUT("TRCD"))="0"))
Begin DoDot:1
+5 IF $GET(ASUL(20,"SSA","CNT"))=1
Begin DoDot:2
+6 NEW Z
SET Z=ASUL(20,"SSA")
DO SSA^ASULDIRR(.Z)
DO SSA(.Z)
SET Z=ASUL(20,"CAN",ASUL(20,"SSA"))
DO CAN(.Z)
End DoDot:2
+7 IF '$TEST
Begin DoDot:2
+8 ;S DIC="^ASUL(20,"_ASUL(20,"REQ","E#")_",2,",DIC(0)="AEMQ",D="B",DZ="??" D DQ^DICQ
+9 NEW Z
SET Z=ASUL(20,"SSA")
DO SSA^ASULDIRR(.Z)
DO SSA(.Z)
SET Z=ASUL(20,"CAN",ASUL(20,"SSA"))
DO CAN(.Z)
End DoDot:2
End DoDot:1
+10 QUIT
RQN(X) ;EP;Request #
+1 SET ASUT(ASUT,"RQN")=$GET(X)
IF $GET(ASUSB)=1
QUIT
+2 DO PUT^DDSVAL(DIE,.DA,34,ASUT(ASUT,"RQN"))
QUIT
RPQ(X) ;EP;Review Point
+1 SET ASUT(ASUT,"RPQ")=$GET(X)
IF $GET(ASUSB)=1
QUIT
+2 DO PUT^DDSVAL(DIE,.DA,56,ASUT(ASUT,"RPQ"))
QUIT
RTP(X) ;EP;Request type
+1 SET ASUT(ASUT,"REQ TYP")=$GET(X)
IF $GET(ASUSB)=1
QUIT
+2 DO PUT^DDSVAL(DIE,.DA,33,ASUT(ASUT,"REQ TYP"))
QUIT
SLC(X) ;EP;Storage Location
+1 SET ASUT(ASUT,"SLC")=ASUL(10,"SLC")
SET ASUT(ASUT,"SLC","NM")=ASUL(10,"SLC","NM")
SET ASUT(ASUT,"PT","SLC")=ASUL(10,"SLC","E#")
IF $GET(ASUSB)=1
QUIT
+2 DO PUT^DDSVALF("SLCNM","","",ASUL(10,"SLC","NM"))
DO PUT^DDSVAL(DIE,.DA,51,ASUL(10,"SLC"))
QUIT
SPQ(X) ;EP;Standard Pack
+1 SET ASUT(ASUT,"SPQ")=$GET(X)
IF $GET(ASUSB)=1
QUIT
+2 DO PUT^DDSVAL(DIE,.DA,61,ASUT(ASUT,"SPQ"))
QUIT
SRC(X) ;EP;Source
+1 SET ASUT(ASUT,"SRC")=ASUL(5,"SRC")
SET ASUT(ASUT,"SRC","NM")=ASUL(5,"SRC","NM")
SET ASUT(ASUT,"PT","SRC")=ASUL(5,"SRC","E#")
IF $GET(ASUSB)=1
QUIT
+2 DO PUT^DDSVAL(DIE,.DA,12,ASUL(5,"SRC"))
DO PUT^DDSVAL(DIE,.DA,.12,ASUL(5,"SRC","E#"),"","I")
QUIT
SSA(X) ;EP ;Sub Sub Activity
+1 SET ASUT(ASUT,"SSA")=ASUL(17,"SSA")
SET ASUT(ASUT,"PT","SSA")=ASUL(17,"SSA","E#")
+2 IF $GET(ASUSB)=1
WRITE "."
+3 IF '$TEST
DO PUT^DDSVAL(DIE,.DA,.11,ASUL(17,"SSA","E#"),"","I")
DO PUT^DDSVAL(DIE,.DA,11,ASUL(17,"SSA"))
+4 IF $GET(ASUT("TYPE"))=7
QUIT
IF $GET(ASUT("TYPE"))=8
QUIT
IF ASUT("TYPE")=2
QUIT
IF '$DATA(ASUL(20))
QUIT
SET ASUT(ASUT,"CAN")=$GET(ASUL(20,"CAN",ASUT(ASUT,"SSA")))
IF $GET(ASUSB)=1
QUIT
+5 DO PUT^DDSVAL(DIE,.DA,15,ASUT(ASUT,"CAN"))
QUIT
SSO(X) ;EP;Stock Sub Object
+1 SET ASUT(ASUT,"SOBJ")=ASUL(3,"SOBJ","CD")
SET ASUT(ASUT,"PT","SOBJ")=ASUL(3,"SOBJ","E#")
IF $GET(ASUSB)=1
QUIT
+2 DO PUT^DDSVAL(DIE,.DA,.17,ASUL(3,"SOBJ","E#"),"","I")
DO PUT^DDSVAL(DIE,.DA,17,ASUL(3,"SOBJ","CD"))
QUIT
SST(X) ;EP;Sub Station
+1 SET ASUT(ASUT,"SST")=ASUL(18,"SST")
SET ASUT(ASUT,"PT","SST")=ASUL(18,"SST","E#")
SET ASUT(ASUT,"SST","NM")=ASUL(18,"SST","NM")
IF $GET(ASUSB)=1
QUIT
+2 DO PUT^DDSVAL(DIE,.DA,13,ASUL(18,"SST"))
DO PUT^DDSVAL(DIE,.DA,.13,ASUL(18,"SST","E#"),"","I")
IF $GET(ASUL(19,"USR","E#"))]""
SET Z=ASUL(19,"USR")
DO REQ(.Z)
+3 QUIT
STA(X) ;EP;Station
+1 SET ASUT(ASUT,"STA")=ASUL(2,"STA","CD")
SET ASUT(ASUT,"PT","STA")=ASUL(2,"STA","E#")
IF $GET(ASUSB)=1
QUIT
+2 DO PUT^DDSVAL(DIE,.DA,3,ASUL(2,"STA","CD"))
DO PUT^DDSVAL(DIE,.DA,.03,ASUL(2,"STA","E#"),"","I")
QUIT
SUI(X) ;EP;Vendor Unit of Issue
+1 SET ASUT(ASUT,"SUI")=$GET(X)
IF ASUT("TRCD")="5C"
SET ASUS("CHG")=1
IF $GET(ASUSB)=1
QUIT
+2 DO PUT^DDSVAL(DIE,.DA,59,ASUT(ASUT,"SUI"))
QUIT
TRN(X) ;EP;Transaction
+1 SET ASUT(ASUT,"TRCD")=$GET(X)
IF $GET(ASUSB)=1
QUIT
+2 DO PUT^DDSVAL(DIE,.DA,1,ASUT(ASUT,"TRCD"))
DO PUT^DDSVAL(DIE,.DA,.3,ASUT(ASUT,"TYPE"))
QUIT
UCS(X) ;EP;Unit cost
+1 SET ASUT(ASUT,"UCS")=$FNUMBER($GET(X),"",2)
IF $GET(ASUSB)=1
QUIT
+2 DO PUT^DDSVAL(DIE,.DA,57,ASUT(ASUT,"UCS"))
QUIT
ULQ(X) ;EP;User Level Quantity
+1 SET ASUT(ASUT,"ULQ")=$GET(X)
IF $GET(ASUSB)=1
QUIT
+2 DO PUT^DDSVAL(DIE,.DA,60,ASUT(ASUT,"ULQ"))
QUIT
USR(X) ;EP;User
+1 SET ASUT(ASUT,"USR")=ASUL(19,"USR")
SET ASUT(ASUT,"PT","USR")=ASUL(19,"USR","E#")
+2 IF $GET(ASUSB)=1
WRITE "."
+3 IF '$TEST
DO PUT^DDSVAL(DIE,.DA,14,ASUL(19,"USR"))
DO PUT^DDSVAL(DIE,.DA,.14,ASUL(19,"USR","E#"),"","I")
+4 IF $GET(ASUL(18,"SST","E#"))]""
SET Z=ASUL(19,"USR")
DO REQ(.Z)
+5 QUIT
VAL(X) ;EP;Value
+1 SET ASUT(ASUT,"VAL")=$FNUMBER($GET(X),"",2)
IF $GET(ASUSB)=1
QUIT
+2 DO PUT^DDSVAL(DIE,.DA,7,ASUT(ASUT,"VAL"))
QUIT
VEN(X) ;EP;Vendor
+1 IF ASUT("TYPE")=2
QUIT
IF ASUT("TYPE")=0
QUIT
IF $GET(ASUSB)=1
QUIT
+2 DO PUT^DDSVAL(DIE,.DA,58,ASUT(ASUT,"VEN NM"))
DO PUT^DDSVAL(DIE,.DA,.19,ASUT(ASUT,"PT","VEN"),"","I")
QUIT
VOU(X) ;EP;Voucher #
+1 SET X=$GET(X)
IF X'["-"
SET X=$EXTRACT(X,1,2)_"-"_$EXTRACT(X,3,4)_"-"_$EXTRACT(X,5,8)
SET ASUT(ASUT,"VOU")=X
IF $GET(ASUSB)=1
QUIT
+2 DO PUT^DDSVAL(DIE,.DA,8,ASUT(ASUT,"VOU"))
QUIT
