ASUJCLER ; IHS/ITSC/LMH -SCREENMAN CLEAR ARRAY ENTRY ;
;;4.2T2;Supply Accounting Mgmt. System;;JUN 30, 2000
;This routine will be used to set local array field variables
ACC ;EP;Account
S ASUT(ASUT,"ACC")=""
S ASUT(ASUT,"PT","ACC")=""
I $G(ASUSB)'=1 D
.D RES,PUT^DDSVAL(DIE,.DA,.04,"")
.D PUT^DDSVAL(DIE,.DA,4,"")
Q
ARE ;EP;Area
S ASUT(ASUT,"AR","CD")=""
S ASUT(ASUT,"PT","AR")=""
I $G(ASUSB)'=1 D
.D RES,PUT^DDSVAL(DIE,.DA,.02,"")
.D PUT^DDSVAL(DIE,.DA,2,"")
Q
AUI ;EP;Area Unit of Issue
S ASUT(ASUT,"AR U/I")=""
I $G(ASUSB)'=1 D
.D RES,PUT^DDSVAL(DIE,.DA,42,"")
Q
BCD ;EP;Bar Code
S ASUT(ASUT,"BCD")=""
I $G(ASUSB)'=1 D
.D RES,PUT^DDSVAL(DIE,.DA,45,"")
Q
CAN ;EP;Common Accounting #
S ASUT(ASUT,"CAN")=""
Q:ASUT("TYPE")=2
I $G(ASUSB)'=1 D
.D RES,PUT^DDSVAL(DIE,.DA,15,"")
Q
CAT ;EP;Category
S ASUT(ASUT,"CAT")=""
S ASUT(ASUT,"PT","CAT")=""
S ASUT(ASUT,"CAT NM")=""
I $G(ASUSB)'=1 D
.D RES,PUT^DDSVAL(DIE,.DA,49,"")
.D PUT^DDSVAL(DIE,.DA,.19,"")
Q
CTG ;EP;Contract Grant #
S ASUT(ASUT,"CTG")=""
I $G(ASUSB)'=1 D
.D RES,PUT^DDSVAL(DIE,.DA,35,"")
Q
FPN ;EP;F P or N fill
S ASUT(ASUT,"FPN")=""
I $G(ASUSB)'=1 D
.D RES,PUT^DDSVAL(DIE,.DA,18,"")
Q
DESC ;EP;Description
S ASUT(ASUT,"DESC")=""
I $G(ASUSB)'=1 D
.D RES,PUT^DDSVAL(DIE,.DA,41,"")
Q
DSO ;EP;Direct Sub Object
S ASUT(ASUT,"SOBJ")=""
S ASUT(ASUT,"PT","SOBJ")=""
I $G(ASUSB)'=1 D
.D RES,PUT^DDSVAL(DIE,.DA,.17,"")
.D PUT^DDSVAL(DIE,.DA,17,"")
Q
DTD ;EP ;Date Due
S ASUT(ASUT,"DTD")=""
I $G(ASUSB)'=1 D
.D RES,PUT^DDSVAL(DIE,.DA,10,"")
Q
DTE ;EP;Date Established
S ASUT(ASUT,"DTE")=""
I $G(ASUSB)'=1 D
.D RES,PUT^DDSVAL(DIE,.DA,.07,"")
Q
DTX ;EP;Date Expired
S ASUT(ASUT,"DTX")=""
I $G(ASUSB)'=1 D
.D RES,PUT^DDSVAL(DIE,.DA,10,"")
Q
EOQ ;EP;Eoq type
S ASUT(ASUT,"EOQ TYP")=""
S ASUT(ASUT,"EOQ MM")=""
S ASUT(ASUT,"EOQ AM")=""
S ASUT(ASUT,"EOQ QM")=""
I $G(ASUSB)'=1 D
.D RES,PUT^DDSVALF("EQTNM","","","")
.D PUT^DDSVAL(DIE,.DA,16,"")
.D PUT^DDSVAL(DIE,.DA,52,"")
.D PUT^DDSVAL(DIE,.DA,54,"")
.D PUT^DDSVAL(DIE,.DA,53,"")
Q
IDX ;EP;Index info
S ASUT(ASUT,"PT","IDX")="",ASUT(ASUT,"IDX")="" ;DFM P1 8/28/98
S ASUT(ASUT,"ACC")="",ASUT(ASUT,"ACC","PT")=""
I $G(ASUSB)'=1 D
.D RES,PUT^DDSVALF("DESC","","","")
.D PUT^DDSVALF("NSN","","","")
.D PUT^DDSVALF("ACC","","","")
.D PUT^DDSVALF("ACCNM","","","")
.D PUT^DDSVAL(DIE,.DA,.05,"")
.D PUT^DDSVAL(DIE,.DA,5,"")
.D PUT^DDSVAL(DIE,.DA,.04,"")
.D PUT^DDSVAL(DIE,.DA,4,"")
.D REFRESH^DDSUTL
Q
KEY ;EP;.01 Key
S ASUT(ASUT,"TRKY")=""
I $G(ASUSB)'=1 D
.D RES,PUT^DDSVAL(DIE,.DA,.01,"")
Q
LTM ;EP;Lead time months
S ASUT(ASUT,"LTM")=""
I $G(ASUSB)'=1 D
.D RES,PUT^DDSVAL(DIE,.DA,55,"")
Q
NSN ;EP;National Stock #
S ASUT(ASUT,"NSN")=""
I $G(ASUSB)'=1 D
.D RES,PUT^DDSVAL(DIE,.DA,43,"")
Q
ORD ;EP;Purchase Order #
S ASUT(ASUT,"ORD")=""
I $G(ASUSB)'=1 D
.D RES,PUT^DDSVAL(DIE,.DA,9,"")
Q
PON ;EP;Purchase Order #
S ASUT(ASUT,"PON")=""
I $G(ASUSB)'=1 D
.D RES,PUT^DDSVAL(DIE,.DA,9,"")
Q
PST ;EP;Post
S ASUT(ASUT,"PST")=""
I $G(ASUSB)'=1 D
.D RES,PUT^DDSVAL(DIE,.DA,31,"")
Q
QTY ;EP;Quantity
S ASUT(ASUT,"QTY")="",ASUT(ASUT,"QTY","REQ")=""
I $G(ASUSB)'=1 D
.D RES,PUT^DDSVAL(DIE,.DA,6,"")
Q
QTYI ;EP;Quantity
S ASUT(ASUT,"QTY","ISS")=""
I $G(ASUSB)'=1 D
.D RES,PUT^DDSVAL(DIE,.DA,36,"")
Q
RES ;Resolve DIE and DA if not set
I $G(DIE)']"" S DIE=$G(ASUJ("FILE"))
I $D(DA)']"" S DA=$G(ASUHDA)
Q
REQ ;EP;Requsitioner
S ASUT(ASUT,"PT","REQ")=""
Q:ASUT("TYPE")=5 Q:ASUT("TYPE")=0 Q:ASUT("TYPE")=2
I $G(ASUSB)'=1 D
.D RES,PUT^DDSVAL(DIE,.DA,.15,"")
.Q:$G(ASUT("TYPE"))=8 Q:$G(ASUT("TYPE"))=7
.D PUT^DDSVALF("HMARE","","","")
Q
RQN ;EP;Request #
S ASUT(ASUT,"RQN")=""
I $G(ASUSB)'=1 D
.D RES,PUT^DDSVAL(DIE,.DA,34,"")
Q
RPQ ;EP;Review Point
S ASUT(ASUT,"RPQ")=""
I $G(ASUSB)'=1 D
.D RES,PUT^DDSVAL(DIE,.DA,56,"")
Q
RTP ;EP;Requset type
S ASUT(ASUT,"REQ TYP")=""
I $G(ASUSB)'=1 D
.D RES,PUT^DDSVAL(DIE,.DA,33,"")
Q
SLC ;EP;Storage Location
S ASUT(ASUT,"SLC")=""
S ASUT(ASUT,"SLC","NM")=""
S ASUT(ASUT,"PT","SLC")=""
I $G(ASUSB)'=1 D
.D RES,PUT^DDSVALF("SLCNM","","","")
.D PUT^DDSVAL(DIE,.DA,51,"")
Q
SPQ ;EP;Requset type
S ASUT(ASUT,"SPQ")=""
I $G(ASUSB)'=1 D
.D RES,PUT^DDSVAL(DIE,.DA,61,"")
Q
SRC ;EP;Source
S ASUT(ASUT,"SRC")=""
S ASUT(ASUT,"SRC","NM")=""
S ASUT(ASUT,"PT","SRC")=""
I $G(ASUSB)'=1 D
.D RES,PUT^DDSVALF("SRCNM","","","")
.D PUT^DDSVAL(DIE,.DA,.12,"")
Q
SSA ;EP ;Sub Sub Activity
S ASUT(ASUT,"SSA")=""
S ASUT(ASUT,"PT","SSA")=""
I $G(ASUSB)'=1 D
.D RES,PUT^DDSVAL(DIE,.DA,.11,"")
.D PUT^DDSVAL(DIE,.DA,11,"")
Q:ASUT("TYPE")=8
S ASUT(ASUT,"CAN")=""
I $G(ASUSB)'=1 D
.D PUT^DDSVAL(DIE,.DA,15,"")
Q
SSO ;EP;Stock Sub Object
S ASUT(ASUT,"SOBJ")=""
S ASUT(ASUT,"PT","SOBJ")=""
I $G(ASUSB)'=1 D
.D RES,PUT^DDSVAL(DIE,.DA,.17,"")
.D PUT^DDSVAL(DIE,.DA,17,"")
Q
SST ;EP;Sub Station
S ASUT(ASUT,"SST")=""
S ASUT(ASUT,"PT","SST")=""
S ASUT(ASUT,"SST","NM")=""
I $G(ASUSB)'=1 D
.D RES,PUT^DDSVAL(DIE,.DA,13,"")
.D PUT^DDSVAL(DIE,.DA,.13,"")
Q
STA ;EP;Station
S ASUT(ASUT,"STA")=""
S ASUT(ASUT,"PT","STA")=""
I $G(ASUSB)'=1 D
.D RES,PUT^DDSVAL(DIE,.DA,3,"")
.D PUT^DDSVAL(DIE,.DA,.03,"")
Q
SUI ;EP;Source Unit of Issue
S ASUT(ASUT,"SUI")=""
I $G(ASUSB)'=1 D
.D RES,PUT^DDSVAL(DIE,.DA,59,"")
Q
TRN ;EP;Transaction
S ASUT(ASUT,"TRCD")=""
I $G(ASUSB)'=1 D
.D RES,PUT^DDSVAL(DIE,.DA,1,"")
Q
UCS ;EP;Unit cost
S ASUT(ASUT,"UCS")=""
I $G(ASUSB)'=1 D
.D RES,PUT^DDSVAL(DIE,.DA,57,"")
Q
ULQ ;EP;Unit cost
S ASUT(ASUT,"ULQ")=""
I $G(ASUSB)'=1 D
.D RES,PUT^DDSVAL(DIE,.DA,60,"")
Q
USR ;EP;User
S ASUT(ASUT,"USR")=""
S ASUT(ASUT,"PT","USR")=""
I $G(ASUSB)'=1 D
.D RES,PUT^DDSVAL(DIE,.DA,14,"")
.D PUT^DDSVAL(DIE,.DA,.14,"")
Q
VAL ;EP;Value
S ASUT(ASUT,"VAL")=""
I $G(ASUSB)'=1 D
.D RES,PUT^DDSVAL(DIE,.DA,7,"")
Q
VEN ;EP;Value
S ASUT(ASUT,"VEN NM")=""
S ASUT(ASUT,"PT","VEN")=""
I $G(ASUSB)'=1 D
.Q:ASUT("TYPE")=2 Q:ASUT("TYPE")=8
.D RES,PUT^DDSVAL(DIE,.DA,.19,"@")
.;D PUT^DDSVAL(DIE,.DA,68,"@")
Q
VOU ;EP;Voucher #
S ASUT(ASUT,"VOU")=""
I $G(ASUSB)'=1 D
.D RES,PUT^DDSVAL(DIE,.DA,8,"")
Q
ASUJCLER ; IHS/ITSC/LMH -SCREENMAN CLEAR ARRAY ENTRY ;
+1 ;;4.2T2;Supply Accounting Mgmt. System;;JUN 30, 2000
+2 ;This routine will be used to set local array field variables
ACC ;EP;Account
+1 SET ASUT(ASUT,"ACC")=""
+2 SET ASUT(ASUT,"PT","ACC")=""
+3 IF $GET(ASUSB)'=1
Begin DoDot:1
+4 DO RES
DO PUT^DDSVAL(DIE,.DA,.04,"")
+5 DO PUT^DDSVAL(DIE,.DA,4,"")
End DoDot:1
+6 QUIT
ARE ;EP;Area
+1 SET ASUT(ASUT,"AR","CD")=""
+2 SET ASUT(ASUT,"PT","AR")=""
+3 IF $GET(ASUSB)'=1
Begin DoDot:1
+4 DO RES
DO PUT^DDSVAL(DIE,.DA,.02,"")
+5 DO PUT^DDSVAL(DIE,.DA,2,"")
End DoDot:1
+6 QUIT
AUI ;EP;Area Unit of Issue
+1 SET ASUT(ASUT,"AR U/I")=""
+2 IF $GET(ASUSB)'=1
Begin DoDot:1
+3 DO RES
DO PUT^DDSVAL(DIE,.DA,42,"")
End DoDot:1
+4 QUIT
BCD ;EP;Bar Code
+1 SET ASUT(ASUT,"BCD")=""
+2 IF $GET(ASUSB)'=1
Begin DoDot:1
+3 DO RES
DO PUT^DDSVAL(DIE,.DA,45,"")
End DoDot:1
+4 QUIT
CAN ;EP;Common Accounting #
+1 SET ASUT(ASUT,"CAN")=""
+2 IF ASUT("TYPE")=2
QUIT
+3 IF $GET(ASUSB)'=1
Begin DoDot:1
+4 DO RES
DO PUT^DDSVAL(DIE,.DA,15,"")
End DoDot:1
+5 QUIT
CAT ;EP;Category
+1 SET ASUT(ASUT,"CAT")=""
+2 SET ASUT(ASUT,"PT","CAT")=""
+3 SET ASUT(ASUT,"CAT NM")=""
+4 IF $GET(ASUSB)'=1
Begin DoDot:1
+5 DO RES
DO PUT^DDSVAL(DIE,.DA,49,"")
+6 DO PUT^DDSVAL(DIE,.DA,.19,"")
End DoDot:1
+7 QUIT
CTG ;EP;Contract Grant #
+1 SET ASUT(ASUT,"CTG")=""
+2 IF $GET(ASUSB)'=1
Begin DoDot:1
+3 DO RES
DO PUT^DDSVAL(DIE,.DA,35,"")
End DoDot:1
+4 QUIT
FPN ;EP;F P or N fill
+1 SET ASUT(ASUT,"FPN")=""
+2 IF $GET(ASUSB)'=1
Begin DoDot:1
+3 DO RES
DO PUT^DDSVAL(DIE,.DA,18,"")
End DoDot:1
+4 QUIT
DESC ;EP;Description
+1 SET ASUT(ASUT,"DESC")=""
+2 IF $GET(ASUSB)'=1
Begin DoDot:1
+3 DO RES
DO PUT^DDSVAL(DIE,.DA,41,"")
End DoDot:1
+4 QUIT
DSO ;EP;Direct Sub Object
+1 SET ASUT(ASUT,"SOBJ")=""
+2 SET ASUT(ASUT,"PT","SOBJ")=""
+3 IF $GET(ASUSB)'=1
Begin DoDot:1
+4 DO RES
DO PUT^DDSVAL(DIE,.DA,.17,"")
+5 DO PUT^DDSVAL(DIE,.DA,17,"")
End DoDot:1
+6 QUIT
DTD ;EP ;Date Due
+1 SET ASUT(ASUT,"DTD")=""
+2 IF $GET(ASUSB)'=1
Begin DoDot:1
+3 DO RES
DO PUT^DDSVAL(DIE,.DA,10,"")
End DoDot:1
+4 QUIT
DTE ;EP;Date Established
+1 SET ASUT(ASUT,"DTE")=""
+2 IF $GET(ASUSB)'=1
Begin DoDot:1
+3 DO RES
DO PUT^DDSVAL(DIE,.DA,.07,"")
End DoDot:1
+4 QUIT
DTX ;EP;Date Expired
+1 SET ASUT(ASUT,"DTX")=""
+2 IF $GET(ASUSB)'=1
Begin DoDot:1
+3 DO RES
DO PUT^DDSVAL(DIE,.DA,10,"")
End DoDot:1
+4 QUIT
EOQ ;EP;Eoq type
+1 SET ASUT(ASUT,"EOQ TYP")=""
+2 SET ASUT(ASUT,"EOQ MM")=""
+3 SET ASUT(ASUT,"EOQ AM")=""
+4 SET ASUT(ASUT,"EOQ QM")=""
+5 IF $GET(ASUSB)'=1
Begin DoDot:1
+6 DO RES
DO PUT^DDSVALF("EQTNM","","","")
+7 DO PUT^DDSVAL(DIE,.DA,16,"")
+8 DO PUT^DDSVAL(DIE,.DA,52,"")
+9 DO PUT^DDSVAL(DIE,.DA,54,"")
+10 DO PUT^DDSVAL(DIE,.DA,53,"")
End DoDot:1
+11 QUIT
IDX ;EP;Index info
+1 ;DFM P1 8/28/98
SET ASUT(ASUT,"PT","IDX")=""
SET ASUT(ASUT,"IDX")=""
+2 SET ASUT(ASUT,"ACC")=""
SET ASUT(ASUT,"ACC","PT")=""
+3 IF $GET(ASUSB)'=1
Begin DoDot:1
+4 DO RES
DO PUT^DDSVALF("DESC","","","")
+5 DO PUT^DDSVALF("NSN","","","")
+6 DO PUT^DDSVALF("ACC","","","")
+7 DO PUT^DDSVALF("ACCNM","","","")
+8 DO PUT^DDSVAL(DIE,.DA,.05,"")
+9 DO PUT^DDSVAL(DIE,.DA,5,"")
+10 DO PUT^DDSVAL(DIE,.DA,.04,"")
+11 DO PUT^DDSVAL(DIE,.DA,4,"")
+12 DO REFRESH^DDSUTL
End DoDot:1
+13 QUIT
KEY ;EP;.01 Key
+1 SET ASUT(ASUT,"TRKY")=""
+2 IF $GET(ASUSB)'=1
Begin DoDot:1
+3 DO RES
DO PUT^DDSVAL(DIE,.DA,.01,"")
End DoDot:1
+4 QUIT
LTM ;EP;Lead time months
+1 SET ASUT(ASUT,"LTM")=""
+2 IF $GET(ASUSB)'=1
Begin DoDot:1
+3 DO RES
DO PUT^DDSVAL(DIE,.DA,55,"")
End DoDot:1
+4 QUIT
NSN ;EP;National Stock #
+1 SET ASUT(ASUT,"NSN")=""
+2 IF $GET(ASUSB)'=1
Begin DoDot:1
+3 DO RES
DO PUT^DDSVAL(DIE,.DA,43,"")
End DoDot:1
+4 QUIT
ORD ;EP;Purchase Order #
+1 SET ASUT(ASUT,"ORD")=""
+2 IF $GET(ASUSB)'=1
Begin DoDot:1
+3 DO RES
DO PUT^DDSVAL(DIE,.DA,9,"")
End DoDot:1
+4 QUIT
PON ;EP;Purchase Order #
+1 SET ASUT(ASUT,"PON")=""
+2 IF $GET(ASUSB)'=1
Begin DoDot:1
+3 DO RES
DO PUT^DDSVAL(DIE,.DA,9,"")
End DoDot:1
+4 QUIT
PST ;EP;Post
+1 SET ASUT(ASUT,"PST")=""
+2 IF $GET(ASUSB)'=1
Begin DoDot:1
+3 DO RES
DO PUT^DDSVAL(DIE,.DA,31,"")
End DoDot:1
+4 QUIT
QTY ;EP;Quantity
+1 SET ASUT(ASUT,"QTY")=""
SET ASUT(ASUT,"QTY","REQ")=""
+2 IF $GET(ASUSB)'=1
Begin DoDot:1
+3 DO RES
DO PUT^DDSVAL(DIE,.DA,6,"")
End DoDot:1
+4 QUIT
QTYI ;EP;Quantity
+1 SET ASUT(ASUT,"QTY","ISS")=""
+2 IF $GET(ASUSB)'=1
Begin DoDot:1
+3 DO RES
DO PUT^DDSVAL(DIE,.DA,36,"")
End DoDot:1
+4 QUIT
RES ;Resolve DIE and DA if not set
+1 IF $GET(DIE)']""
SET DIE=$GET(ASUJ("FILE"))
+2 IF $DATA(DA)']""
SET DA=$GET(ASUHDA)
+3 QUIT
REQ ;EP;Requsitioner
+1 SET ASUT(ASUT,"PT","REQ")=""
+2 IF ASUT("TYPE")=5
QUIT
IF ASUT("TYPE")=0
QUIT
IF ASUT("TYPE")=2
QUIT
+3 IF $GET(ASUSB)'=1
Begin DoDot:1
+4 DO RES
DO PUT^DDSVAL(DIE,.DA,.15,"")
+5 IF $GET(ASUT("TYPE"))=8
QUIT
IF $GET(ASUT("TYPE"))=7
QUIT
+6 DO PUT^DDSVALF("HMARE","","","")
End DoDot:1
+7 QUIT
RQN ;EP;Request #
+1 SET ASUT(ASUT,"RQN")=""
+2 IF $GET(ASUSB)'=1
Begin DoDot:1
+3 DO RES
DO PUT^DDSVAL(DIE,.DA,34,"")
End DoDot:1
+4 QUIT
RPQ ;EP;Review Point
+1 SET ASUT(ASUT,"RPQ")=""
+2 IF $GET(ASUSB)'=1
Begin DoDot:1
+3 DO RES
DO PUT^DDSVAL(DIE,.DA,56,"")
End DoDot:1
+4 QUIT
RTP ;EP;Requset type
+1 SET ASUT(ASUT,"REQ TYP")=""
+2 IF $GET(ASUSB)'=1
Begin DoDot:1
+3 DO RES
DO PUT^DDSVAL(DIE,.DA,33,"")
End DoDot:1
+4 QUIT
SLC ;EP;Storage Location
+1 SET ASUT(ASUT,"SLC")=""
+2 SET ASUT(ASUT,"SLC","NM")=""
+3 SET ASUT(ASUT,"PT","SLC")=""
+4 IF $GET(ASUSB)'=1
Begin DoDot:1
+5 DO RES
DO PUT^DDSVALF("SLCNM","","","")
+6 DO PUT^DDSVAL(DIE,.DA,51,"")
End DoDot:1
+7 QUIT
SPQ ;EP;Requset type
+1 SET ASUT(ASUT,"SPQ")=""
+2 IF $GET(ASUSB)'=1
Begin DoDot:1
+3 DO RES
DO PUT^DDSVAL(DIE,.DA,61,"")
End DoDot:1
+4 QUIT
SRC ;EP;Source
+1 SET ASUT(ASUT,"SRC")=""
+2 SET ASUT(ASUT,"SRC","NM")=""
+3 SET ASUT(ASUT,"PT","SRC")=""
+4 IF $GET(ASUSB)'=1
Begin DoDot:1
+5 DO RES
DO PUT^DDSVALF("SRCNM","","","")
+6 DO PUT^DDSVAL(DIE,.DA,.12,"")
End DoDot:1
+7 QUIT
SSA ;EP ;Sub Sub Activity
+1 SET ASUT(ASUT,"SSA")=""
+2 SET ASUT(ASUT,"PT","SSA")=""
+3 IF $GET(ASUSB)'=1
Begin DoDot:1
+4 DO RES
DO PUT^DDSVAL(DIE,.DA,.11,"")
+5 DO PUT^DDSVAL(DIE,.DA,11,"")
End DoDot:1
+6 IF ASUT("TYPE")=8
QUIT
+7 SET ASUT(ASUT,"CAN")=""
+8 IF $GET(ASUSB)'=1
Begin DoDot:1
+9 DO PUT^DDSVAL(DIE,.DA,15,"")
End DoDot:1
+10 QUIT
SSO ;EP;Stock Sub Object
+1 SET ASUT(ASUT,"SOBJ")=""
+2 SET ASUT(ASUT,"PT","SOBJ")=""
+3 IF $GET(ASUSB)'=1
Begin DoDot:1
+4 DO RES
DO PUT^DDSVAL(DIE,.DA,.17,"")
+5 DO PUT^DDSVAL(DIE,.DA,17,"")
End DoDot:1
+6 QUIT
SST ;EP;Sub Station
+1 SET ASUT(ASUT,"SST")=""
+2 SET ASUT(ASUT,"PT","SST")=""
+3 SET ASUT(ASUT,"SST","NM")=""
+4 IF $GET(ASUSB)'=1
Begin DoDot:1
+5 DO RES
DO PUT^DDSVAL(DIE,.DA,13,"")
+6 DO PUT^DDSVAL(DIE,.DA,.13,"")
End DoDot:1
+7 QUIT
STA ;EP;Station
+1 SET ASUT(ASUT,"STA")=""
+2 SET ASUT(ASUT,"PT","STA")=""
+3 IF $GET(ASUSB)'=1
Begin DoDot:1
+4 DO RES
DO PUT^DDSVAL(DIE,.DA,3,"")
+5 DO PUT^DDSVAL(DIE,.DA,.03,"")
End DoDot:1
+6 QUIT
SUI ;EP;Source Unit of Issue
+1 SET ASUT(ASUT,"SUI")=""
+2 IF $GET(ASUSB)'=1
Begin DoDot:1
+3 DO RES
DO PUT^DDSVAL(DIE,.DA,59,"")
End DoDot:1
+4 QUIT
TRN ;EP;Transaction
+1 SET ASUT(ASUT,"TRCD")=""
+2 IF $GET(ASUSB)'=1
Begin DoDot:1
+3 DO RES
DO PUT^DDSVAL(DIE,.DA,1,"")
End DoDot:1
+4 QUIT
UCS ;EP;Unit cost
+1 SET ASUT(ASUT,"UCS")=""
+2 IF $GET(ASUSB)'=1
Begin DoDot:1
+3 DO RES
DO PUT^DDSVAL(DIE,.DA,57,"")
End DoDot:1
+4 QUIT
ULQ ;EP;Unit cost
+1 SET ASUT(ASUT,"ULQ")=""
+2 IF $GET(ASUSB)'=1
Begin DoDot:1
+3 DO RES
DO PUT^DDSVAL(DIE,.DA,60,"")
End DoDot:1
+4 QUIT
USR ;EP;User
+1 SET ASUT(ASUT,"USR")=""
+2 SET ASUT(ASUT,"PT","USR")=""
+3 IF $GET(ASUSB)'=1
Begin DoDot:1
+4 DO RES
DO PUT^DDSVAL(DIE,.DA,14,"")
+5 DO PUT^DDSVAL(DIE,.DA,.14,"")
End DoDot:1
+6 QUIT
VAL ;EP;Value
+1 SET ASUT(ASUT,"VAL")=""
+2 IF $GET(ASUSB)'=1
Begin DoDot:1
+3 DO RES
DO PUT^DDSVAL(DIE,.DA,7,"")
End DoDot:1
+4 QUIT
VEN ;EP;Value
+1 SET ASUT(ASUT,"VEN NM")=""
+2 SET ASUT(ASUT,"PT","VEN")=""
+3 IF $GET(ASUSB)'=1
Begin DoDot:1
+4 IF ASUT("TYPE")=2
QUIT
IF ASUT("TYPE")=8
QUIT
+5 DO RES
DO PUT^DDSVAL(DIE,.DA,.19,"@")
+6 ;D PUT^DDSVAL(DIE,.DA,68,"@")
End DoDot:1
+7 QUIT
VOU ;EP;Voucher #
+1 SET ASUT(ASUT,"VOU")=""
+2 IF $GET(ASUSB)'=1
Begin DoDot:1
+3 DO RES
DO PUT^DDSVAL(DIE,.DA,8,"")
End DoDot:1
+4 QUIT
