ASUJSAVE.m

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)