- 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
